ROUTINE XQOR2**: Difference between revisions

From VistApedia
Jump to navigationJump to search
Created page with "ROUTINE XQOR2 == Listing == === XQOR2 === XQOR2 ; SLC/KCM - Process Extended Actions, Protocols ;8/23/91 10:33 ; ;;8.0;KERNEL;;Jul 10, 1995 === ACT === ACT ;From:..."
 
 
(8 intermediate revisions by the same user not shown)
Line 6: Line 6:
=== ACT ===
=== ACT ===
  ACT ;From: STAK^XQOR1
  ACT ;From: STAK^XQOR1
    ;; D0 == ^TMP("XQORS",$J,XQORS,"REF")
    ;; ^ORD(101,D0,26)=  (#26) HEADER [E1,245K] ^
    ;;
     I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"26)"))'[0 S X=^(26) X:$L(X) X
     I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"26)"))'[0 S X=^(26) X:$L(X) X
    ;; ^ORD(101,D0,24)=  (#24) SCREEN [E1,245K] ^
    ;;  saved into lvar ORNSV (used later in ACT1 called from ORD+1)
     S ORNSV="" I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"24)"))'[0 S ORNSV=^(24)
     S ORNSV="" I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"24)"))'[0 S ORNSV=^(24)
    ;
     K Y S (J,^TMP("XQORS",$J,XQORS,"ITM"))=0
     K Y S (J,^TMP("XQORS",$J,XQORS,"ITM"))=0
=== ORD ===
=== ORD ===
    ;; $O loop thru ITEM Multiple most commonly in PROTOCOL FILE -- could be OPTION FILE
    ;; ^ORD(101,D0,10,0)=^101.01PA^^  (#10) ITEM
    ;; ^ORD(101,D0,10,D1,0)=  (#.01) ITEM [1P:101] ^ (#2) MNEMONIC [2F] ^
    ;;            ==>(#3) SEQUENCE [3N] ^ (#4) MODIFYING ACTION [4P:101] ^
    ;;            ==>(#5) FORMAT CODE [5S] ^ (#6) DISPLAY NAME [6F] ^
    ;; ^ORD(101,D0,10,D1,1)=  (#11) PROMPT [1F] ^ (#12) DEFAULT [2F] ^
    ;;            ==>(#13) HELP [3F] ^ (#14) MODE [4F] ^
    ;;
  ORD S J=$O(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_")")) G:J'>0 SET
  ORD S J=$O(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_")")) G:J'>0 SET
    ;;
    ;; Note ORNSV code screens entries in subroutine ACT1
     I $D(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_",0)")) S X=^(0) I +X D:$L(ORNSV) ACT1 I $T S Y=$S(+$P(X,"^",3):+$P(X,"^",3),1:1000+J),Y(Y,J)=X
     I $D(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_",0)")) S X=^(0) I +X D:$L(ORNSV) ACT1 I $T S Y=$S(+$P(X,"^",3):+$P(X,"^",3),1:1000+J),Y(Y,J)=X
    ;; and get next one
     G ORD
     G ORD
=== SET ===
=== SET ===
  SET S (I,Y)=0
  SET S (I,Y)=0
      ;; NOTE: @FallThru
 
=== SET1 ===
=== SET1 ===
  SET1 S Y=$O(Y(Y)) G:Y="" EX S J=0
  SET1 S Y=$O(Y(Y)) G:Y="" EX S J=0
      ;; NOTE: @FallThru
=== SET2 ===
=== SET2 ===
  SET2 S J=$O(Y(Y,J)) G:J="" SET1
  SET2 S J=$O(Y(Y,J)) G:J="" SET1
Line 25: Line 49:
       G SET2
       G SET2
=== EX ===
=== EX ===
    ;; kill off ORNSV ( ^ORD(101,D0,24)=  (#24) SCREEN [E1,245K] ^ )
  EX K ORNSV Q
  EX K ORNSV Q
=== ACT1 ===
=== ACT1 ===
; note: caller depends on $TEST being set by Xecuting ORNSV
;;      Note context is lvars DA, DA(1)
;;                  NOT lvars D0, D1
  ACT1 N DA S DA(1)=+^TMP("XQORS",$J,XQORS,"VPT"),DA=J N J,X,Y X ORNSV
  ACT1 N DA S DA(1)=+^TMP("XQORS",$J,XQORS,"VPT"),DA=J N J,X,Y X ORNSV
       Q
       Q
=== NUL ===
=== NUL ===
  NUL ;From: STAK^XQOR1
  NUL ;From: STAK^XQOR1
    ;; if we are in the PROTOCOL file,
    ;; then ^ORD(101,D0,26)=  (#26) HEADER [E1,245K] ^
    ;; Xecute it
    ;; and zero out the ITM count
     I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"26)"))'[0 S X=^(26) X:$L(X) X
     I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"26)"))'[0 S X=^(26) X:$L(X) X
     S ^TMP("XQORS",$J,XQORS,"ITM")=0
     S ^TMP("XQORS",$J,XQORS,"ITM")=0
     Q
     Q
=== UP ===
=== UP ===
  UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
== Other ==
== Other ==

Latest revision as of 22:32, 13 December 2020

ROUTINE XQOR2

Listing

XQOR2

XQOR2 ; SLC/KCM - Process Extended Actions, Protocols ;8/23/91  10:33 ;
     ;;8.0;KERNEL;;Jul 10, 1995

ACT

ACT ;From: STAK^XQOR1
    ;; D0 == ^TMP("XQORS",$J,XQORS,"REF")
    ;; ^ORD(101,D0,26)=  (#26) HEADER [E1,245K] ^
    ;;
    I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"26)"))'[0 S X=^(26) X:$L(X) X

    ;; ^ORD(101,D0,24)=  (#24) SCREEN [E1,245K] ^
    ;;  saved into lvar ORNSV (used later in ACT1 called from ORD+1)
    S ORNSV="" I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"24)"))'[0 S ORNSV=^(24)
    ;
    K Y S (J,^TMP("XQORS",$J,XQORS,"ITM"))=0

ORD

    ;; $O loop thru ITEM Multiple most commonly in PROTOCOL FILE -- could be OPTION FILE
    ;; ^ORD(101,D0,10,0)=^101.01PA^^  (#10) ITEM
    ;; ^ORD(101,D0,10,D1,0)=  (#.01) ITEM [1P:101] ^ (#2) MNEMONIC [2F] ^
    ;;            ==>(#3) SEQUENCE [3N] ^ (#4) MODIFYING ACTION [4P:101] ^
    ;;            ==>(#5) FORMAT CODE [5S] ^ (#6) DISPLAY NAME [6F] ^
    ;; ^ORD(101,D0,10,D1,1)=  (#11) PROMPT [1F] ^ (#12) DEFAULT [2F] ^
    ;;            ==>(#13) HELP [3F] ^ (#14) MODE [4F] ^
    ;;
ORD S J=$O(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_")")) G:J'>0 SET
    ;;
    ;; Note ORNSV code screens entries in subroutine ACT1
    I $D(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_",0)")) S X=^(0) I +X D:$L(ORNSV) ACT1 I $T S Y=$S(+$P(X,"^",3):+$P(X,"^",3),1:1000+J),Y(Y,J)=X
    ;; and get next one 
    G ORD

SET

SET  S (I,Y)=0
     ;; NOTE: @FallThru

SET1

SET1 S Y=$O(Y(Y)) G:Y="" EX S J=0
     ;; NOTE: @FallThru

SET2

SET2 S J=$O(Y(Y,J)) G:J="" SET1
     S ^TMP("XQORS",$J,XQORS,"ITM")=^TMP("XQORS",$J,XQORS,"ITM")+1, ^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM"))=+Y(Y,J)_";"_$P(^TMP("XQORS",$J,XQORS,"VPT"),";",2)
     S ^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM"),"IEN")=J
     I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",+$P(Y(Y,J),"^",4) S ^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM"),"MA")=$P(Y(Y,J),"^",4)_^TMP("XQORS",$J,0,"FILE")
     I $L($P($G(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_",1)")),"^")) S ^TMP("XQORS",$J,XQORS,"PMT",$$UP($P(^(1),"^")),^TMP("XQORS",$J,XQORS,"ITM"))=""
     G SET2

EX

   ;; kill off ORNSV ( ^ORD(101,D0,24)=  (#24) SCREEN [E1,245K] ^ )
EX K ORNSV Q

ACT1

; note: caller depends on $TEST being set by Xecuting ORNSV
;;      Note context is lvars DA, DA(1)
;;                  NOT lvars D0, D1
ACT1 N DA S DA(1)=+^TMP("XQORS",$J,XQORS,"VPT"),DA=J N J,X,Y X ORNSV
     Q

NUL

NUL ;From: STAK^XQOR1
    ;; if we are in the PROTOCOL file,
    ;; then ^ORD(101,D0,26)=  (#26) HEADER [E1,245K] ^
    ;; Xecute it
    ;; and zero out the ITM count
    I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"26)"))'[0 S X=^(26) X:$L(X) X
    S ^TMP("XQORS",$J,XQORS,"ITM")=0
    Q

UP

UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

Other

Retrieved from "https://vistapedia.com/index.php?title=ROUTINE_XQOR2**&oldid=18647"