GMTSXAD ; SLC/KER - List Parameters/Display ; 02/27/2002
;;2.7;Health Summary;**47,49**;Oct 20, 1995
Q
;
; External References in GMTSXAD
; DBIA 10026 ^DIR
; DBIA 10063 ^%ZTLOAD
; DBIA 10086 ^%ZIS
; DBIA 10086 HOME^%ZIS
; DBIA 10089 ^%ZISC
; DBIA 10103 $$FMTE^XLFDT
; DBIA 10103 $$NOW^XLFDT
; DBIA 10112 $$SITE^VASITE
;
EN ; Main Entry Point
D EN2(+($G(DUZ))) Q
EN2(X) ; Entry for User
K ^TMP("GMTSXAD",$J) N GMTSENV,ZTRTN,GMTSNM S ZTRTN="RPT^GMTSXAD",GMTSENV=$$ENV Q:+GMTSENV=0
N GMTSUSR S GMTSUSR=+($G(X)) S GMTSNM=$$UNM^GMTSXAW3(+($G(GMTSUSR))) Q:'$L(GMTSNM)
W !!,"Display user default Health Summary Type list for ",GMTSNM
D PRE,CPL,LIST,DISP
Q
EN3 ; Entry for Site Parameters
K ^TMP("GMTSXAD",$J) N GMTSENV,ZTRTN,GMTSNM S ZTRTN="RPT^GMTSXAD",GMTSENV=$$ENV Q:+GMTSENV=0
N GMTSUSR S GMTSUSR=.5 S GMTSNM=$P($$SITE^VASITE,"^",2) Q:'$L(GMTSNM)
W !!,"Display default Health Summary Type list for ",GMTSNM
D PRE,CPL,DISP
Q
;
; Report
PRE ; Precedence
N GMTSPRE,GMTSM S GMTSPRE=$$PRE^GMTSXAL(GMTSUSR)
S:+($G(GMTSUSR))=.5 GMTSPRE=$$DEF^GMTSXAW
S:(+($G(GMTSUSR))=.5)&('$L(GMTSPRE)) GMTSPRE=$$PRE^GMTSXAL(.5)
S GMTSM=$L(GMTSPRE,";")
Q:'$L(GMTSPRE) N GMTSI,GMTSE,GMTST,GMTSA,GMTSN,GMTSP,GMTSH,GMTSC,GMTSALW D EN^GMTSXAW
S (GMTSC,GMTSI)=0 F GMTSI=1:1 Q:$P(GMTSPRE,";",GMTSI)="" D
. S GMTSA=$P(GMTSPRE,";",GMTSI) Q:'$L(GMTSA) S GMTSE=$O(GMTSALW("B",GMTSA,0))
. S GMTST=$P($G(GMTSALW("B",GMTSA,+GMTSE)),"^",4) Q:GMTSA'="NAT"&('$L(GMTST))
. S GMTST=$S(GMTSA="USR":(GMTST_" preferences"),GMTSA="NAT":"National Health Summary Types",1:(GMTST_" defined"))
. S GMTSC=GMTSC+1 D:GMTSC=1 PRE2 D TL((" "_GMTSC_" "_GMTST))
Q
PRE2 ; Precedence Title
D TL(" Precedence of Parameters: "),AL($G(GMTSPRE)),BL Q
CPL ; Compile Method
D EN3^GMTSXAC Q
LIST ; Health Summary Types List
N GMTS,GMTSALW D GETILIST^GMTSXAL(.GMTS,GMTSUSR),EN^GMTSXAW
N GMTS1,GMTS2,GMTST,GMTSA,GMTSI,GMTSN,GMTSEN,GMTSC,GMTSS S GMTSC=0 F Q:$L($G(GMTSS))>29 S GMTSS=$G(GMTSS)_" "
S GMTS1=0 F S GMTS1=$O(GMTS("AB",GMTS1)) Q:+GMTS1=0 D
. S GMTS2=0 F S GMTS2=$O(GMTS("AB",GMTS1,GMTS2)) Q:+GMTS2=0 D
. . S GMTSA=$P($G(GMTS("AB",GMTS1,GMTS2)),"^",1) Q:'$L(GMTSA)
. . S GMTSI=+($P($G(GMTS("AB",GMTS1,GMTS2)),"^",2)) Q:+GMTSI'>0
. . S GMTSN=$$UP^GMTSXA($P($G(GMTS("AB",GMTS1,GMTS2)),"^",3)) Q:'$L(GMTSN)
. . S GMTSEN=+($O(GMTSALW("B",GMTSA,0))) Q:+GMTSEN'>0&(GMTSA'="NAT")
. . S GMTSEN=$P($G(GMTSALW("B",GMTSA,GMTSEN)),"^",4) Q:'$L(GMTSEN)&(GMTSA'="NAT")
. . S GMTSEN=GMTSEN_" defined types" S:GMTSA="NAT" GMTSEN="National types" S GMTSC=GMTSC+1 S GMTSEN=" "_GMTSEN F Q:$L(GMTSEN)>29 S GMTSEN=GMTSEN_" "
. . D:GMTSC=1 LIST2
. . D TL($S(+GMTS2=1:GMTSEN,1:GMTSS))
. . D AL(($J(GMTSC,2)_" "_GMTSN))
Q
LIST2 ; List Title
D TL(" The CPRS Reports Tab will list the following Health Summary Types:"),BL Q
;
DISP ; Display Report
I '$L($G(ZTRTN)) K ^TMP("GMTSXAD",$J) Q
N POP D DEV,HOME^%ZIS Q
DEV ; Device for Display
W ! N %ZIS,IOP S %ZIS="PQ" D ^%ZIS Q:POP I $D(IO("Q")) D QUE Q
NOQUE ; Do not Queue Report
W:IOST["C-" @IOF D @ZTRTN,^%ZISC Q
QUE ; Queue Report
N %,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK I '$D(ZTRTN) K ^TMP("GMTSXAD",$J) Q
K IO("Q"),ZTSAVE S ZTSAVE("^TMP(""GMTSXAD"",$J,")=""
S ZTDESC="Health Summary Types List User Defaults",ZTIO=$G(ION),ZTDTH=$H
D ^%ZTLOAD I $D(ZTSK) W !!,"Request queued",! H 3 W @IOF
I '$D(ZTSK) W !!,"Request not queued",! H 3 W @IOF
K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE D ^%ZISC Q
;
RPT ; Report
W ! Q:'$D(^TMP("GMTSXAD",$J))
N GMTSHDR,GMTSLC,GMTSI,GMTST,GMTSEXIT S (GMTSI,GMTSLC)=0 D HDRP
F S GMTSI=$O(^TMP("GMTSXAD",$J,GMTSI)) Q:+($G(GMTSEXIT))>0 Q:+GMTSI=0 D Q:+($G(GMTSEXIT))>0
. S GMTST=$G(^TMP("GMTSXAD",$J,GMTSI,0)),GMTSLC=GMTSLC+1 W !,GMTST
. D:$G(IOST)["C-"&(GMTSLC>(+($G(IOSL))-4)) CONT
. K:+($G(GMTSEXIT))>0 ^TMP("GMTSXAD",$J)
W:$G(IOST)["P-"&($L($G(IOF))) @IOF
K ^TMP("GMTSXAD",$J)
Q
CONT ; Page Break/Continue Report
I $G(IOST)["P-" W:$L($G(IOF)) @IOF S GMTSLC=0 D HDRP Q
N GMTSCONT S GMTSCONT="" I $G(IOST)["C-" S GMTSCONT=$$PG W:$L($G(IOF)) @IOF W:'$L($G(IOF)) !! S GMTSLC=0 D HDRP
S:GMTSCONT["^" GMTSEXIT=1
Q
PG(X) ; Page Break
N DIR,DTOUT,DIRUT,DIROUT,DUOUT S DIR(0)="EA",DIR("A")=" Press <Return> to continue ",(DIR("?"),DIR("??"))="^W !,"" Enter either <Return> or '^'"""
W ! D ^DIR S X=$S((+($G(DTOUT))+($G(DUOUT))+($G(DIRUT)))>0:"^",1:"") Q X
HDRP ; Page/Report Header
N GMTSS,GMTS1,GMTS2,GMTS3,GMTSL
S GMTSS=$P($$SITE^VASITE,"^",2)
S GMTS1=" Health Summary Types list for CPRS Reports Tab"
S:(+($G(GMTSUSR))=.5)&($L(GMTSS)) GMTS1=" "_GMTSS_" Defaults for CPRS Reports Tab"
S:+($G(GMTSHDR))>0 GMTS1=GMTS1_" <continued> "
S GMTS2=$$UP^GMTSXA($P($$FMTE^XLFDT($$NOW^XLFDT,"ZM"),"@",1)) F Q:$L(GMTS1)'<(78-$L(GMTS2)) S GMTS1=GMTS1_" "
S GMTS1=GMTS1_GMTS2 S GMTSL=" -" F Q:$L(GMTSL)'<$L(GMTS1) S GMTSL=GMTSL_"-"
W !,GMTS1,!,GMTSL,! S GMTSLC=+($G(GMTSLC))+3
Q
;
; Miscellaneous
ENV(X) ; Environment check
D HOME^%ZIS Q:'$L($$UNM^GMTSXAW3(+($G(DUZ)))) 0
Q 1
; Add Report Lines
BL ; Blank Line
D TL("") Q
TL(X) ; Text Line
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
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[HGMTSXAD 5707 printed Oct 16, 2024@18:01:33 Page 2
GMTSXAD ; SLC/KER - List Parameters/Display ; 02/27/2002
+1 ;;2.7;Health Summary;**47,49**;Oct 20, 1995
+2 QUIT
+3 ;
+4 ; External References in GMTSXAD
+5 ; DBIA 10026 ^DIR
+6 ; DBIA 10063 ^%ZTLOAD
+7 ; DBIA 10086 ^%ZIS
+8 ; DBIA 10086 HOME^%ZIS
+9 ; DBIA 10089 ^%ZISC
+10 ; DBIA 10103 $$FMTE^XLFDT
+11 ; DBIA 10103 $$NOW^XLFDT
+12 ; DBIA 10112 $$SITE^VASITE
+13 ;
EN ; Main Entry Point
+1 DO EN2(+($GET(DUZ)))
QUIT
EN2(X) ; Entry for User
+1 KILL ^TMP("GMTSXAD",$JOB)
NEW GMTSENV,ZTRTN,GMTSNM
SET ZTRTN="RPT^GMTSXAD"
SET GMTSENV=$$ENV
if +GMTSENV=0
QUIT
+2 NEW GMTSUSR
SET GMTSUSR=+($GET(X))
SET GMTSNM=$$UNM^GMTSXAW3(+($GET(GMTSUSR)))
if '$LENGTH(GMTSNM)
QUIT
+3 WRITE !!,"Display user default Health Summary Type list for ",GMTSNM
+4 DO PRE
DO CPL
DO LIST
DO DISP
+5 QUIT
EN3 ; Entry for Site Parameters
+1 KILL ^TMP("GMTSXAD",$JOB)
NEW GMTSENV,ZTRTN,GMTSNM
SET ZTRTN="RPT^GMTSXAD"
SET GMTSENV=$$ENV
if +GMTSENV=0
QUIT
+2 NEW GMTSUSR
SET GMTSUSR=.5
SET GMTSNM=$PIECE($$SITE^VASITE,"^",2)
if '$LENGTH(GMTSNM)
QUIT
+3 WRITE !!,"Display default Health Summary Type list for ",GMTSNM
+4 DO PRE
DO CPL
DO DISP
+5 QUIT
+6 ;
+7 ; Report
PRE ; Precedence
+1 NEW GMTSPRE,GMTSM
SET GMTSPRE=$$PRE^GMTSXAL(GMTSUSR)
+2 if +($GET(GMTSUSR))=.5
SET GMTSPRE=$$DEF^GMTSXAW
+3 if (+($GET(GMTSUSR))=.5)&('$LENGTH(GMTSPRE))
SET GMTSPRE=$$PRE^GMTSXAL(.5)
+4 SET GMTSM=$LENGTH(GMTSPRE,";")
+5 if '$LENGTH(GMTSPRE)
QUIT
NEW GMTSI,GMTSE,GMTST,GMTSA,GMTSN,GMTSP,GMTSH,GMTSC,GMTSALW
DO EN^GMTSXAW
+6 SET (GMTSC,GMTSI)=0
FOR GMTSI=1:1
if $PIECE(GMTSPRE,";",GMTSI)=""
QUIT
Begin DoDot:1
+7 SET GMTSA=$PIECE(GMTSPRE,";",GMTSI)
if '$LENGTH(GMTSA)
QUIT
SET GMTSE=$ORDER(GMTSALW("B",GMTSA,0))
+8 SET GMTST=$PIECE($GET(GMTSALW("B",GMTSA,+GMTSE)),"^",4)
if GMTSA'="NAT"&('$LENGTH(GMTST))
QUIT
+9 SET GMTST=$SELECT(GMTSA="USR":(GMTST_" preferences"),GMTSA="NAT":"National Health Summary Types",1:(GMTST_" defined"))
+10 SET GMTSC=GMTSC+1
if GMTSC=1
DO PRE2
DO TL((" "_GMTSC_" "_GMTST))
End DoDot:1
+11 QUIT
PRE2 ; Precedence Title
+1 DO TL(" Precedence of Parameters: ")
DO AL($GET(GMTSPRE))
DO BL
QUIT
CPL ; Compile Method
+1 DO EN3^GMTSXAC
QUIT
LIST ; Health Summary Types List
+1 NEW GMTS,GMTSALW
DO GETILIST^GMTSXAL(.GMTS,GMTSUSR)
DO EN^GMTSXAW
+2 NEW GMTS1,GMTS2,GMTST,GMTSA,GMTSI,GMTSN,GMTSEN,GMTSC,GMTSS
SET GMTSC=0
FOR
if $LENGTH($GET(GMTSS))>29
QUIT
SET GMTSS=$GET(GMTSS)_" "
+3 SET GMTS1=0
FOR
SET GMTS1=$ORDER(GMTS("AB",GMTS1))
if +GMTS1=0
QUIT
Begin DoDot:1
+4 SET GMTS2=0
FOR
SET GMTS2=$ORDER(GMTS("AB",GMTS1,GMTS2))
if +GMTS2=0
QUIT
Begin DoDot:2
+5 SET GMTSA=$PIECE($GET(GMTS("AB",GMTS1,GMTS2)),"^",1)
if '$LENGTH(GMTSA)
QUIT
+6 SET GMTSI=+($PIECE($GET(GMTS("AB",GMTS1,GMTS2)),"^",2))
if +GMTSI'>0
QUIT
+7 SET GMTSN=$$UP^GMTSXA($PIECE($GET(GMTS("AB",GMTS1,GMTS2)),"^",3))
if '$LENGTH(GMTSN)
QUIT
+8 SET GMTSEN=+($ORDER(GMTSALW("B",GMTSA,0)))
if +GMTSEN'>0&(GMTSA'="NAT")
QUIT
+9 SET GMTSEN=$PIECE($GET(GMTSALW("B",GMTSA,GMTSEN)),"^",4)
if '$LENGTH(GMTSEN)&(GMTSA'="NAT")
QUIT
+10 SET GMTSEN=GMTSEN_" defined types"
if GMTSA="NAT"
SET GMTSEN="National types"
SET GMTSC=GMTSC+1
SET GMTSEN=" "_GMTSEN
FOR
if $LENGTH(GMTSEN)>29
QUIT
SET GMTSEN=GMTSEN_" "
+11 if GMTSC=1
DO LIST2
+12 DO TL($SELECT(+GMTS2=1:GMTSEN,1:GMTSS))
+13 DO AL(($JUSTIFY(GMTSC,2)_" "_GMTSN))
End DoDot:2
End DoDot:1
+14 QUIT
LIST2 ; List Title
+1 DO TL(" The CPRS Reports Tab will list the following Health Summary Types:")
DO BL
QUIT
+2 ;
DISP ; Display Report
+1 IF '$LENGTH($GET(ZTRTN))
KILL ^TMP("GMTSXAD",$JOB)
QUIT
+2 NEW POP
DO DEV
DO HOME^%ZIS
QUIT
DEV ; Device for Display
+1 WRITE !
NEW %ZIS,IOP
SET %ZIS="PQ"
DO ^%ZIS
if POP
QUIT
IF $DATA(IO("Q"))
DO QUE
QUIT
NOQUE ; Do not Queue Report
+1 if IOST["C-"
WRITE @IOF
DO @ZTRTN
DO ^%ZISC
QUIT
QUE ; Queue Report
+1 NEW %,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
IF '$DATA(ZTRTN)
KILL ^TMP("GMTSXAD",$JOB)
QUIT
+2 KILL IO("Q"),ZTSAVE
SET ZTSAVE("^TMP(""GMTSXAD"",$J,")=""
+3 SET ZTDESC="Health Summary Types List User Defaults"
SET ZTIO=$GET(ION)
SET ZTDTH=$HOROLOG
+4 DO ^%ZTLOAD
IF $DATA(ZTSK)
WRITE !!,"Request queued",!
HANG 3
WRITE @IOF
+5 IF '$DATA(ZTSK)
WRITE !!,"Request not queued",!
HANG 3
WRITE @IOF
+6 KILL ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
DO ^%ZISC
QUIT
+7 ;
RPT ; Report
+1 WRITE !
if '$DATA(^TMP("GMTSXAD",$JOB))
QUIT
+2 NEW GMTSHDR,GMTSLC,GMTSI,GMTST,GMTSEXIT
SET (GMTSI,GMTSLC)=0
DO HDRP
+3 FOR
SET GMTSI=$ORDER(^TMP("GMTSXAD",$JOB,GMTSI))
if +($GET(GMTSEXIT))>0
QUIT
if +GMTSI=0
QUIT
Begin DoDot:1
+4 SET GMTST=$GET(^TMP("GMTSXAD",$JOB,GMTSI,0))
SET GMTSLC=GMTSLC+1
WRITE !,GMTST
+5 if $GET(IOST)["C-"&(GMTSLC>(+($GET(IOSL))-4))
DO CONT
+6 if +($GET(GMTSEXIT))>0
KILL ^TMP("GMTSXAD",$JOB)
End DoDot:1
if +($GET(GMTSEXIT))>0
QUIT
+7 if $GET(IOST)["P-"&($LENGTH($GET(IOF)))
WRITE @IOF
+8 KILL ^TMP("GMTSXAD",$JOB)
+9 QUIT
CONT ; Page Break/Continue Report
+1 IF $GET(IOST)["P-"
if $LENGTH($GET(IOF))
WRITE @IOF
SET GMTSLC=0
DO HDRP
QUIT
+2 NEW GMTSCONT
SET GMTSCONT=""
IF $GET(IOST)["C-"
SET GMTSCONT=$$PG
if $LENGTH($GET(IOF))
WRITE @IOF
if '$LENGTH($GET(IOF))
WRITE !!
SET GMTSLC=0
DO HDRP
+3 if GMTSCONT["^"
SET GMTSEXIT=1
+4 QUIT
PG(X) ; Page Break
+1 NEW DIR,DTOUT,DIRUT,DIROUT,DUOUT
SET DIR(0)="EA"
SET DIR("A")=" Press <Return> to continue "
SET (DIR("?"),DIR("??"))="^W !,"" Enter either <Return> or '^'"""
+2 WRITE !
DO ^DIR
SET X=$SELECT((+($GET(DTOUT))+($GET(DUOUT))+($GET(DIRUT)))>0:"^",1:"")
QUIT X
HDRP ; Page/Report Header
+1 NEW GMTSS,GMTS1,GMTS2,GMTS3,GMTSL
+2 SET GMTSS=$PIECE($$SITE^VASITE,"^",2)
+3 SET GMTS1=" Health Summary Types list for CPRS Reports Tab"
+4 if (+($GET(GMTSUSR))=.5)&($LENGTH(GMTSS))
SET GMTS1=" "_GMTSS_" Defaults for CPRS Reports Tab"
+5 if +($GET(GMTSHDR))>0
SET GMTS1=GMTS1_" <continued> "
+6 SET GMTS2=$$UP^GMTSXA($PIECE($$FMTE^XLFDT($$NOW^XLFDT,"ZM"),"@",1))
FOR
if $LENGTH(GMTS1)'<(78-$LENGTH(GMTS2))
QUIT
SET GMTS1=GMTS1_" "
+7 SET GMTS1=GMTS1_GMTS2
SET GMTSL=" -"
FOR
if $LENGTH(GMTSL)'<$LENGTH(GMTS1)
QUIT
SET GMTSL=GMTSL_"-"
+8 WRITE !,GMTS1,!,GMTSL,!
SET GMTSLC=+($GET(GMTSLC))+3
+9 QUIT
+10 ;
+11 ; Miscellaneous
ENV(X) ; Environment check
+1 DO HOME^%ZIS
if '$LENGTH($$UNM^GMTSXAW3(+($GET(DUZ))))
QUIT 0
+2 QUIT 1
+3 ; Add Report Lines
BL ; Blank Line
+1 DO TL("")
QUIT
TL(X) ; Text Line
+1 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 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
