- 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
- 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
