GMTSXAC ; SLC/KER - List Parameters/Compile Method ; 02/27/2002
;;2.7;Health Summary;**47,49**;Oct 20, 1995
Q
;
; External References
;
; None
;
; This routine expects:
;
; GMTSUSR Pointer to User
;
EN ; Main Entry
N GMTSG D CPL,SH Q
EN1 ; Display Compile Method - Single ? Help
N GMTSG S GMTSG=1 D CPLH Q
EN2 ; Display Compile Method - Double ?? Help
N GMTSG S GMTSG=1 D CPL Q
EN3 ; Display Preferred Compile Method
N GMTSG D CPL Q
;
CPL ; Compile Method
N GMTSPRE,GMTSCPL,GMTSCPA,GMTSCPI,GMTSM,GMTSALW,GMTSU,GMTSO D EN^GMTSXAW
S (GMTSO,GMTSU)=+($G(GMTSUSR)) S:+GMTSU=0 GMTSU=+($G(DUZ)) N GMTSUSR S GMTSUSR=GMTSU
S GMTSPRE=$$PRE^GMTSXAL(+($G(GMTSUSR))),GMTSM=$L(GMTSPRE,";") Q:'$L(GMTSPRE)
S GMTSCPL=$$CPL^GMTSXAL(+($G(GMTSUSR)))
S:(+($G(GMTSO))=.5)&('$L(GMTSCPL)) GMTSCPL=1
I +($G(GMTSG))'>0 D:+GMTSCPL>0 CPLA D:+GMTSCPL'>0 CPLO D BL
I +($G(GMTSG))>0 D CPLH,BL,CPLA,BL,TL(" OR ---"),BL,CPLO
Q
CPLH ; Compile Help - Header
D TL(" Health Summary Types may be added to CPRS reports tab by either appending")
D TL(" them to the list or by overwriting existing Health Summaries on the list.") Q
CPLA ; Compile = Append
N GMTSI,GMTSC,GMTSH,GMTSN,GMTSE,GMTSA,GMTST,GMTSP,GMTSL,GMTSM
S GMTSP=$G(GMTSPRE) Q:$L(GMTSP,";")'>1 S (GMTSC,GMTSL)=0,GMTSM="A"
S:+($G(GMTSO))=.5 GMTSP=$$DEF^GMTSXAW
F GMTSI=1:1 S GMTST=$P($G(GMTSP),";",GMTSI) Q:'$L(GMTST) D
. S:$P($G(GMTSP),";",(GMTSI+1))="" GMTSL=1
. I GMTST="NAT" S GMTSC=GMTSC+1,GMTSN="National",GMTSA=GMTST D:GMTSC=1&(+($G(GMTSG))'>0) CPLT D CPLP Q
. S GMTSE=+($O(GMTSALW("B",GMTST,0))) Q:+GMTSE=0 S GMTSE=$G(GMTSALW(+GMTSE))
. S GMTSA=$P(GMTSE,"^",1) Q:'$L(GMTSA) S GMTSN=$P(GMTSE,"^",4) Q:'$L(GMTSN) S GMTSC=GMTSC+1 D:GMTSC=1&(+($G(GMTSG))'>0) CPLT D CPLP
Q
CPLO ; Compile = Overwrite
N GMTSI,GMTSC,GMTSH,GMTSN,GMTSE,GMTSA,GMTST,GMTSP,GMTSL,GMTSM,GMTSNAT S GMTSP=$G(GMTSPRE) Q:$L(GMTSP,";")'>1 S (GMTSNAT,GMTSL,GMTSC)=0,GMTSM="O"
S:+($G(GMTSO))=.5 GMTSP=$$DEF^GMTSXAW
F GMTSI=$L(GMTSP,";"):-1 S GMTST=$P($G(GMTSP),";",GMTSI) Q:'$L(GMTST) Q:GMTSI=0 D
. S:$P($G(GMTSP),";",(GMTSI-1))="" GMTSL=1 S:GMTSI-1=0 GMTSL=1 I GMTST="NAT" S GMTSNAT=1 Q
. S GMTSE=+($O(GMTSALW("B",GMTST,0))) Q:+GMTSE=0 S GMTSE=$G(GMTSALW(+GMTSE))
. S GMTSA=$P(GMTSE,"^",1) Q:'$L(GMTSA) S GMTSN=$P(GMTSE,"^",4) Q:'$L(GMTSN)
. S GMTSC=GMTSC+1 D:GMTSC=1&(+($G(GMTSG))'>0) CPLT D CPLP
I +GMTSNAT>0 S GMTSC=+($G(GMTSC))+1,GMTSN="National",(GMTSA,GMTST)="NAT" D:GMTSC=1&(+($G(GMTSG))'>0) CPLT D CPLP
D:$G(GMTSP)["NAT" INDP
Q
CPLP ; Compile Parameter
Q:'$L($G(GMTST)) Q:'$L($G(GMTSN)) Q:'$L($G(GMTSA)) Q:'$L(GMTSM)
N GMTSP S:GMTSM="A" GMTSH=$S(+($G(GMTSC))=1:"Add",1:"Append with") S:GMTSM="O" GMTSH=$S(+($G(GMTSC))=1:"Add",1:"Overwrite with")
S GMTSL=+($G(GMTSL)) S:GMTST="NAT"&(GMTSC>1) GMTSH="Add" S:GMTST'="NAT" GMTSP=" "_GMTSH_" "_GMTSN_" Defined Summary Types" S:GMTST="NAT" GMTSP=" "_GMTSH_" National Defined Summary Types"
S:+($G(GMTSC))>1 GMTSP=GMTSP_" (if found)" S:+($G(GMTSC))=1 GMTSP=GMTSP_" to the list" S:+GMTSL'>0 GMTSP=GMTSP_", then" D TL(GMTSP)
Q
CPLT ; Compile Title
D BL,TL(" Method for building the List: "),AL(($S(+($G(GMTSCPL))'>0:"Overwrite",1:"Append"))),BL Q
INDP ; Independent Types
N GMTSI,GMTSPA,GMTSPT,GMTSPI,GMTSPE,GMTSMSG,GMTSX,GMTST,GMTSL,GMTSR,GMTSS,GMTSN
S GMTSN=" ",GMTSPT=$$DEF^GMTSXAW
F GMTSI=1:1 S GMTSPA=$P(GMTSPT,";",GMTSI) Q:'$L(GMTSPA) D
. S GMTSPI=$$ETI^GMTSXAW3(GMTSPA),GMTSPE=$$EMC^GMTSXAW3(+($G(GMTSPI))),GMTSX=$G(GMTSX)_", "_GMTSPE
S:$E(GMTSX,1,2)=", " GMTSX=$E(GMTSX,3,$L(GMTSX)) S:$L(GMTSX,", ")>1 GMTSX=$P(GMTSX,", ",1,($L(GMTSX,", ")-1))_" and "_$P(GMTSX,", ",$L(GMTSX,", "))
S GMTST="National Health Summary Types are added to the list",GMTSL=$L(GMTST),GMTST="Note: "_GMTST,GMTST=GMTSN_GMTST D BL,TL(GMTST)
S GMTSN=GMTSN_" ",GMTST="independently of "_$S($L(GMTSX):GMTSX,1:"other")_" defined types, and placed on the list in the order specified by the precedence."
D INDPT
Q
INDPT ; Independent Types (text)
I $L(GMTST)'>GMTSL S GMTST=GMTSN_GMTST D TL(GMTST) Q
F Q:'$L(GMTST) D INDPL
Q
INDPL ; Independent Types (long text)
I $L(GMTST)'>GMTSL D TL((GMTSN_GMTST)) S GMTST="" Q
N GMTSREM,GMTSSTO,GMTSI F GMTSI=1:1 Q:$L($P(GMTST," ",1,GMTSI))>GMTSL Q:'$L($P(GMTST," ",GMTSI))
S GMTSSTO=$$TRIM^GMTSXA($P(GMTST," ",1,(GMTSI-1))," "),GMTSREM=$$TRIM^GMTSXA($P(GMTST," ",GMTSI,299)," ")
D:$L(GMTSSTO) TL((GMTSN_GMTSSTO)) S GMTST=GMTSREM
Q
;
; Miscellaneous
SH ; Show ^TMP Global
N GMTSN,GMTSC,GMTSW S GMTSN="^TMP(""GMTSXAD"","_$J_",0)",GMTSC="^TMP(""GMTSXAD"","_$J_",",GMTSW="^TMP(""GMTSXAD"","_$J_",0)"
F S GMTSN=$Q(@GMTSN) Q:GMTSN=""!(GMTSN'[GMTSC) W:GMTSN'[GMTSW !,@GMTSN
K ^TMP("GMTSXAD",$J)
Q
BL ; Blank Line
D TL("") Q
TL(X) ; Text Line
I +($G(GMTSG))>0 W !,$G(X) Q
N GMTSC S X=$G(X),GMTSC=+($G(^TMP("GMTSXAD",$J,0))),GMTSC=GMTSC+1,^TMP("GMTSXAD",$J,GMTSC,0)=X,^TMP("GMTSXAD",$J,0)=GMTSC Q
AL(X) ; Append Line
I +($G(GMTSG))>0 W $G(X) Q
N GMTSC S X=$G(X),GMTSC=+($G(^TMP("GMTSXAD",$J,0))),^TMP("GMTSXAD",$J,GMTSC,0)=$G(^TMP("GMTSXAD",$J,GMTSC,0))_X,^TMP("GMTSXAD",$J,0)=GMTSC Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSXAC 5394 printed Nov 22, 2024@17:10:53 Page 2
GMTSXAC ; SLC/KER - List Parameters/Compile Method ; 02/27/2002
+1 ;;2.7;Health Summary;**47,49**;Oct 20, 1995
+2 QUIT
+3 ;
+4 ; External References
+5 ;
+6 ; None
+7 ;
+8 ; This routine expects:
+9 ;
+10 ; GMTSUSR Pointer to User
+11 ;
EN ; Main Entry
+1 NEW GMTSG
DO CPL
DO SH
QUIT
EN1 ; Display Compile Method - Single ? Help
+1 NEW GMTSG
SET GMTSG=1
DO CPLH
QUIT
EN2 ; Display Compile Method - Double ?? Help
+1 NEW GMTSG
SET GMTSG=1
DO CPL
QUIT
EN3 ; Display Preferred Compile Method
+1 NEW GMTSG
DO CPL
QUIT
+2 ;
CPL ; Compile Method
+1 NEW GMTSPRE,GMTSCPL,GMTSCPA,GMTSCPI,GMTSM,GMTSALW,GMTSU,GMTSO
DO EN^GMTSXAW
+2 SET (GMTSO,GMTSU)=+($GET(GMTSUSR))
if +GMTSU=0
SET GMTSU=+($GET(DUZ))
NEW GMTSUSR
SET GMTSUSR=GMTSU
+3 SET GMTSPRE=$$PRE^GMTSXAL(+($GET(GMTSUSR)))
SET GMTSM=$LENGTH(GMTSPRE,";")
if '$LENGTH(GMTSPRE)
QUIT
+4 SET GMTSCPL=$$CPL^GMTSXAL(+($GET(GMTSUSR)))
+5 if (+($GET(GMTSO))=.5)&('$LENGTH(GMTSCPL))
SET GMTSCPL=1
+6 IF +($GET(GMTSG))'>0
if +GMTSCPL>0
DO CPLA
if +GMTSCPL'>0
DO CPLO
DO BL
+7 IF +($GET(GMTSG))>0
DO CPLH
DO BL
DO CPLA
DO BL
DO TL(" OR ---")
DO BL
DO CPLO
+8 QUIT
CPLH ; Compile Help - Header
+1 DO TL(" Health Summary Types may be added to CPRS reports tab by either appending")
+2 DO TL(" them to the list or by overwriting existing Health Summaries on the list.")
QUIT
CPLA ; Compile = Append
+1 NEW GMTSI,GMTSC,GMTSH,GMTSN,GMTSE,GMTSA,GMTST,GMTSP,GMTSL,GMTSM
+2 SET GMTSP=$GET(GMTSPRE)
if $LENGTH(GMTSP,";")'>1
QUIT
SET (GMTSC,GMTSL)=0
SET GMTSM="A"
+3 if +($GET(GMTSO))=.5
SET GMTSP=$$DEF^GMTSXAW
+4 FOR GMTSI=1:1
SET GMTST=$PIECE($GET(GMTSP),";",GMTSI)
if '$LENGTH(GMTST)
QUIT
Begin DoDot:1
+5 if $PIECE($GET(GMTSP),";",(GMTSI+1))=""
SET GMTSL=1
+6 IF GMTST="NAT"
SET GMTSC=GMTSC+1
SET GMTSN="National"
SET GMTSA=GMTST
if GMTSC=1&(+($GET(GMTSG))'>0)
DO CPLT
DO CPLP
QUIT
+7 SET GMTSE=+($ORDER(GMTSALW("B",GMTST,0)))
if +GMTSE=0
QUIT
SET GMTSE=$GET(GMTSALW(+GMTSE))
+8 SET GMTSA=$PIECE(GMTSE,"^",1)
if '$LENGTH(GMTSA)
QUIT
SET GMTSN=$PIECE(GMTSE,"^",4)
if '$LENGTH(GMTSN)
QUIT
SET GMTSC=GMTSC+1
if GMTSC=1&(+($GET(GMTSG))'>0)
DO CPLT
DO CPLP
End DoDot:1
+9 QUIT
CPLO ; Compile = Overwrite
+1 NEW GMTSI,GMTSC,GMTSH,GMTSN,GMTSE,GMTSA,GMTST,GMTSP,GMTSL,GMTSM,GMTSNAT
SET GMTSP=$GET(GMTSPRE)
if $LENGTH(GMTSP,";")'>1
QUIT
SET (GMTSNAT,GMTSL,GMTSC)=0
SET GMTSM="O"
+2 if +($GET(GMTSO))=.5
SET GMTSP=$$DEF^GMTSXAW
+3 FOR GMTSI=$LENGTH(GMTSP,";"):-1
SET GMTST=$PIECE($GET(GMTSP),";",GMTSI)
if '$LENGTH(GMTST)
QUIT
if GMTSI=0
QUIT
Begin DoDot:1
+4 if $PIECE($GET(GMTSP),";",(GMTSI-1))=""
SET GMTSL=1
if GMTSI-1=0
SET GMTSL=1
IF GMTST="NAT"
SET GMTSNAT=1
QUIT
+5 SET GMTSE=+($ORDER(GMTSALW("B",GMTST,0)))
if +GMTSE=0
QUIT
SET GMTSE=$GET(GMTSALW(+GMTSE))
+6 SET GMTSA=$PIECE(GMTSE,"^",1)
if '$LENGTH(GMTSA)
QUIT
SET GMTSN=$PIECE(GMTSE,"^",4)
if '$LENGTH(GMTSN)
QUIT
+7 SET GMTSC=GMTSC+1
if GMTSC=1&(+($GET(GMTSG))'>0)
DO CPLT
DO CPLP
End DoDot:1
+8 IF +GMTSNAT>0
SET GMTSC=+($GET(GMTSC))+1
SET GMTSN="National"
SET (GMTSA,GMTST)="NAT"
if GMTSC=1&(+($GET(GMTSG))'>0)
DO CPLT
DO CPLP
+9 if $GET(GMTSP)["NAT"
DO INDP
+10 QUIT
CPLP ; Compile Parameter
+1 if '$LENGTH($GET(GMTST))
QUIT
if '$LENGTH($GET(GMTSN))
QUIT
if '$LENGTH($GET(GMTSA))
QUIT
if '$LENGTH(GMTSM)
QUIT
+2 NEW GMTSP
if GMTSM="A"
SET GMTSH=$SELECT(+($GET(GMTSC))=1:"Add",1:"Append with")
if GMTSM="O"
SET GMTSH=$SELECT(+($GET(GMTSC))=1:"Add",1:"Overwrite with")
+3 SET GMTSL=+($GET(GMTSL))
if GMTST="NAT"&(GMTSC>1)
SET GMTSH="Add"
if GMTST'="NAT"
SET GMTSP=" "_GMTSH_" "_GMTSN_" Defined Summary Types"
if GMTST="NAT"
SET GMTSP=" "_GMTSH_" National Defined Summary Types"
+4 if +($GET(GMTSC))>1
SET GMTSP=GMTSP_" (if found)"
if +($GET(GMTSC))=1
SET GMTSP=GMTSP_" to the list"
if +GMTSL'>0
SET GMTSP=GMTSP_", then"
DO TL(GMTSP)
+5 QUIT
CPLT ; Compile Title
+1 DO BL
DO TL(" Method for building the List: ")
DO AL(($SELECT(+($GET(GMTSCPL))'>0:"Overwrite",1:"Append")))
DO BL
QUIT
INDP ; Independent Types
+1 NEW GMTSI,GMTSPA,GMTSPT,GMTSPI,GMTSPE,GMTSMSG,GMTSX,GMTST,GMTSL,GMTSR,GMTSS,GMTSN
+2 SET GMTSN=" "
SET GMTSPT=$$DEF^GMTSXAW
+3 FOR GMTSI=1:1
SET GMTSPA=$PIECE(GMTSPT,";",GMTSI)
if '$LENGTH(GMTSPA)
QUIT
Begin DoDot:1
+4 SET GMTSPI=$$ETI^GMTSXAW3(GMTSPA)
SET GMTSPE=$$EMC^GMTSXAW3(+($GET(GMTSPI)))
SET GMTSX=$GET(GMTSX)_", "_GMTSPE
End DoDot:1
+5 if $EXTRACT(GMTSX,1,2)=", "
SET GMTSX=$EXTRACT(GMTSX,3,$LENGTH(GMTSX))
if $LENGTH(GMTSX,", ")>1
SET GMTSX=$PIECE(GMTSX,", ",1,($LENGTH(GMTSX,", ")-1))_" and "_$PIECE(GMTSX,", ",$LENGTH(GMTSX,", "))
+6 SET GMTST="National Health Summary Types are added to the list"
SET GMTSL=$LENGTH(GMTST)
SET GMTST="Note: "_GMTST
SET GMTST=GMTSN_GMTST
DO BL
DO TL(GMTST)
+7 SET GMTSN=GMTSN_" "
SET GMTST="independently of "_$SELECT($LENGTH(GMTSX):GMTSX,1:"other")_" defined types, and placed on the list in the order specified by the precedence."
+8 DO INDPT
+9 QUIT
INDPT ; Independent Types (text)
+1 IF $LENGTH(GMTST)'>GMTSL
SET GMTST=GMTSN_GMTST
DO TL(GMTST)
QUIT
+2 FOR
if '$LENGTH(GMTST)
QUIT
DO INDPL
+3 QUIT
INDPL ; Independent Types (long text)
+1 IF $LENGTH(GMTST)'>GMTSL
DO TL((GMTSN_GMTST))
SET GMTST=""
QUIT
+2 NEW GMTSREM,GMTSSTO,GMTSI
FOR GMTSI=1:1
if $LENGTH($PIECE(GMTST," ",1,GMTSI))>GMTSL
QUIT
if '$LENGTH($PIECE(GMTST," ",GMTSI))
QUIT
+3 SET GMTSSTO=$$TRIM^GMTSXA($PIECE(GMTST," ",1,(GMTSI-1))," ")
SET GMTSREM=$$TRIM^GMTSXA($PIECE(GMTST," ",GMTSI,299)," ")
+4 if $LENGTH(GMTSSTO)
DO TL((GMTSN_GMTSSTO))
SET GMTST=GMTSREM
+5 QUIT
+6 ;
+7 ; Miscellaneous
SH ; Show ^TMP Global
+1 NEW GMTSN,GMTSC,GMTSW
SET GMTSN="^TMP(""GMTSXAD"","_$JOB_",0)"
SET GMTSC="^TMP(""GMTSXAD"","_$JOB_","
SET GMTSW="^TMP(""GMTSXAD"","_$JOB_",0)"
+2 FOR
SET GMTSN=$QUERY(@GMTSN)
if GMTSN=""!(GMTSN'[GMTSC)
QUIT
if GMTSN'[GMTSW
WRITE !,@GMTSN
+3 KILL ^TMP("GMTSXAD",$JOB)
+4 QUIT
BL ; Blank Line
+1 DO TL("")
QUIT
TL(X) ; Text Line
+1 IF +($GET(GMTSG))>0
WRITE !,$GET(X)
QUIT
+2 NEW GMTSC
SET X=$GET(X)
SET GMTSC=+($GET(^TMP("GMTSXAD",$JOB,0)))
SET GMTSC=GMTSC+1
SET ^TMP("GMTSXAD",$JOB,GMTSC,0)=X
SET ^TMP("GMTSXAD",$JOB,0)=GMTSC
QUIT
AL(X) ; Append Line
+1 IF +($GET(GMTSG))>0
WRITE $GET(X)
QUIT
+2 NEW GMTSC
SET X=$GET(X)
SET GMTSC=+($GET(^TMP("GMTSXAD",$JOB,0)))
SET ^TMP("GMTSXAD",$JOB,GMTSC,0)=$GET(^TMP("GMTSXAD",$JOB,GMTSC,0))_X
SET ^TMP("GMTSXAD",$JOB,0)=GMTSC
QUIT
