Difference between revisions of "ROUTINE XQOR2**"

From VistApedia
Jump to: navigation, 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:...")
 
(ACT1)
 
(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