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