- GMTSXPS1 ; SLC/KER - Health Summary Status ; 08/27/2002
- ;;2.7;Health Summary;**35,34,46,56**;Oct 20, 1995
- ;
- ; External References
- ; DBIA 10086 HOME^%ZIS
- ; DBIA 10086 ^%ZIS
- ; DBIA 10089 ^%ZISC
- ; DBIA 10063 ^%ZTLOAD
- ; DBIA 10096 ^%ZOSF("UCI")
- ; DBIA 10096 ^%ZOSF("PROD")
- ; DBIA 10096 ^%ZOSF("TEST")
- ; DBIA 10060 ^VA(200,
- ; DBIA 2056 $$GET1^DIQ (file #4 and 200)
- ; DBIA 1131 ^XMB("NETNAME")
- ; DBIA 10091 ^XMB(1, file #4.3
- ; DBIA 10070 ^XMD
- ; DBIA 10103 $$NOW^XLFDT
- ; DBIA 10103 $$FMTE^XLFDT
- ;
- EN ; Display status only
- N POP,GMTSENV S GMTSENV=$$ENV Q:'GMTSENV
- K ^TMP($J,"GMTSINFO"),GMTSMAIL N X,Y,ZTSAVE D HDR
- D:'$D(GMTSHORT) FI,INS^GMTSXPS2 D OUTPUT Q
- SEND ; Send status to G.GMTS@ISC-SLC.DOMAIN.EXT
- N POP,GMTSENV S GMTSENV=$$ENV2 Q:'GMTSENV
- S GMTSIENS=$G(GMTSIENS) S:$L(GMTSIENS) GMTSIENS=";"_GMTSIENS_";"
- S GMTSENV=$$ROK("XMD") Q:'GMTSENV K ^TMP($J,"GMTSINFO") N X,Y,ZTSAVE,ZTQUEUED,ZTREQ,ZTRTN
- S:$D(GMTSHORT) ZTSAVE("GMTSHORT")="" S:$L($G(GMTSBLD)) ZTSAVE("GMTSBLD")="" S:$D(GMTSINST) ZTSAVE("GMTSINST")="" S:$L($G(GMTSIENS)) ZTSAVE("GMTSIENS")=""
- S ZTRTN="SENDTO^GMTSXPS1",ZTDESC="Health Summary Status Report Msg",ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS K Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN Q
- SENDTO ; Send (Tasked)
- N GMTSMAIL S GMTSMAIL="" S:$D(ZTQUEUED) ZTREQ="@"
- N X,Y D HDR D:'$D(GMTSHORT) FI,INS^GMTSXPS2 D OUTPUT Q
- ;
- HDR ; Report Header
- N X D TITLE,ASOF D:$D(GMTSINST) MTBY D INAC,BLD D BL
- Q
- TITLE ; As of date
- N X S X=$S($D(GMTSINST)&('$L($G(GMTSBLD))):"Health Summary Installation",$D(GMTSINST)&($L($G(GMTSBLD))):($G(GMTSBLD)_" Installation"),1:"Health Summary Status") D TT(X),BL Q
- ASOF ; As of date
- N X S X=$$NOW S:$L(X) X=$$TB($S($D(GMTSINST):" Installed on:",1:" As of:"))_X D:$L(X) TL(X) Q
- INAC ; In Account
- N X S X=$$UCI($$U) S:$L(X) X=$$TB(" Install Account:")_X D:$L(X) TL(X) Q
- MTBY ; Maintained by
- N X,Y S X=$$P,Y=$P(X,"^",2),X=$P(X,"^",1) S:$L(X) X=$$TB($S($D(GMTSINST):" Installed by:",1:" Maintained by:"))_X S:$L(X)&($L(Y)) X=X_" "_Y D:$L(X) TL(X) Q
- BLD ; Install Build
- Q:$D(GMTSINST)&($L($G(GMTSBLD))) N X S X=$G(GMTSBLD) Q:'$L(X) S:$L(X) X=$$TB(" Build:")_X D:$L(X) TL(X) Q
- ;
- FI ; Health Summary Files
- Q:$D(GMTSHORT)
- N X S X="",X=X_$J("",37-$L(X))_" Total",X=X_$J("",48-$L(X))_"Last" D TL(X)
- S X=" File",X=X_$J("",37-$L(X))_"Entries",X=X_$J("",48-$L(X))_"Entry" D TL(X)
- S X="",$P(X,"-",51)="-",X=" "_X D TL(X)
- D F142,F1421,F14299,BL
- Q
- F142 ; Health Summary Type file 142
- N X,GMTSA,GMTSAT,GMTSAP,GMTSL,GMTST,GMTSI S X=" Health Summary Type",(GMTSL,GMTST,GMTSI)=0
- F S GMTSI=$O(^GMT(142,GMTSI)) Q:+GMTSI=0 S GMTSL=GMTSI,GMTST=GMTST+1
- S X=X_$J("",32-$L(X))_$J(GMTST,10),X=X_$J("",42-$L(X))_$J(GMTSL,10) D TL(X)
- S GMTSA=$O(^GMT(142,"B","GMTS HS ADHOC OPTION",0))
- S X=" Ad Hoc Health Summary Type",(GMTSL,GMTST,GMTSI)=0
- I GMTSA=0 S X=X_$J("",37-$L(X))_"Missing Ad Hoc Health Summary Type" D TL(X) Q
- F S GMTSI=$O(^GMT(142,GMTSA,1,GMTSI)) Q:+GMTSI=0 S GMTSL=GMTSI,GMTST=GMTST+1
- S X=X_$J("",32-$L(X))_$J(GMTST,10),X=X_$J("",42-$L(X))_$J(GMTSL,10) S:GMTSA'=12 X=X_$J("",57-$L(X))_"Invalid IEN" D TL(X)
- Q
- F1421 ; Health Summary Component file 142.1
- N X,GMTSA,GMTSAC,GMTSAT,GMTSAP,GMTSL,GMTST,GMTSE,GMTSI
- S X=" Health Summary Component",(GMTSAT,GMTSAP,GMTSAC,GMTSL,GMTST,GMTSI,GMTSE)=0
- F S GMTSI=$O(^GMT(142.1,GMTSI)) Q:+GMTSI=0 D
- . S GMTSL=GMTSI,GMTST=GMTST+1 S:GMTSI<501 GMTSE=GMTSE+1
- . S GMTSA=$P($G(^GMT(142.1,GMTSI,0)),"^",6) S:GMTSA="T" GMTSAT=+($G(GMTSAT))+1 S:GMTSA="P" GMTSAP=+($G(GMTSAP))+1 S:GMTSA="" GMTSAC=+($G(GMTSAC))+1
- S X=X_$J("",32-$L(X))_$J(GMTST,10),X=X_$J("",42-$L(X))_$J(GMTSL,10) D TL(X)
- I +($G(GMTSE))>0 S X=" Exported",X=X_$J("",32-$L(X))_$J(GMTSE,10) D TL(X)
- I +($G(GMTSAT))>0 S X=" Temporarily Disabled",X=X_$J("",32-$L(X))_$J(GMTSAT,10) D TL(X)
- I +($G(GMTSAP))>0 S X=" Permanently Disabled",X=X_$J("",32-$L(X))_$J(GMTSAP,10) D TL(X)
- I +($G(GMTSAC))>0&(+($G(GMTSAC))'=+($G(GMTST))) S X=" Active Components",X=X_$J("",32-$L(X))_$J(GMTSAC,10) D TL(X)
- D STA^GMTSXPS3
- Q
- F14299 ; Health Summary Parameter file 142.9
- N X,GMTSA,GMTSL,GMTST,GMTSI S X=" Health Summary Parameters",(GMTSL,GMTST,GMTSI)=0
- F S GMTSI=$O(^GMT(142.99,GMTSI)) Q:+GMTSI=0 S GMTSL=GMTSI,GMTST=GMTST+1
- S X=X_$J("",32-$L(X))_$J(GMTST,10),X=X_$J("",42-$L(X))_$J(GMTSL,10) D TL(X)
- Q
- ;
- ; Retrieve Data
- U(X) ; UCI where Health Summary is installed
- N GMTSU,GMTSP,GMTST S GMTST=$G(X) X ^%ZOSF("UCI") S GMTSU=Y
- S:Y=^%ZOSF("PROD") GMTSP=" (Production)" S:Y'=^%ZOSF("PROD") GMTSP=" (Test)" S:GMTSU["DEM" GMTSP=" (Demo)"
- S X="",$P(X,"^",1)=GMTSU,$P(X,"^",2)=GMTSP Q X
- UCI(X) ; UCI Format
- S X=$G(X) N GMTSA,GMTST S GMTSA=$P(X,"^",1),GMTST=$P(X,"^",2) S:$L(GMTST) GMTST=$$MX($$TRIM($$PA(GMTST)))
- S:$L($P(GMTSA,",",1))=3&($L($P(GMTSA,",",2))=3) GMTSA="["_GMTSA_"]" S:$L(GMTSA)&($L(GMTST)) GMTST="("_GMTST_")"
- S X="" S:$L(GMTSA) X=GMTSA S:$L(X)&($L(GMTST)) X=X_" "_GMTST S:'$L(X)&($L(GMTST)) X=GMTST
- Q X
- P(X) ; Person
- S X=+($G(DUZ)) Q:'$L($P($G(^VA(200,+($G(X)),0)),"^",1)) "UNKNOWN^"
- N GMTSDUZ,GMTSPH S GMTSDUZ=+($G(DUZ))
- S GMTSPH=$P($G(^VA(200,GMTSDUZ,.13)),"^",2) S:GMTSPH="" GMTSPH=$P($G(^VA(200,GMTSDUZ,.13)),"^",1) S:GMTSPH="" GMTSPH=$P($G(^VA(200,GMTSDUZ,.13)),"^",3) S:GMTSPH="" GMTSPH=$P($G(^VA(200,GMTSDUZ,.13)),"^",4)
- S GMTSDUZ=$P(^VA(200,GMTSDUZ,0),"^",1),X=GMTSDUZ_"^"_GMTSPH Q X
- INST(X) ; Institution
- S X=$G(^XMB("NETNAME")) I $L(X) S:X[".DOMAIN.EXT" X=$P(X,".DOMAIN.EXT",1) S:X["." X=$P(X,".",$L(X,".")) Q X
- S X=$P($G(^XMB(1,1,"XUS")),"^",17) I +X>0 S X=$$GET1^DIQ(4,+X,.01,"E") Q:$L(X) X
- S X="" Q X
- ;
- OUTPUT ; Show global array (display or mail)
- D:$D(GMTSMAIL) MAIL,CLR D:'$D(GMTSMAIL) DSP,CLR Q
- DISPLAY ; Display global array
- N GMTSI S GMTSI=0 F S GMTSI=$O(^TMP($J,"GMTSINFO",GMTSI)) Q:+GMTSI=0 D
- . W !,^TMP($J,"GMTSINFO",GMTSI)
- Q
- MAIL ; Mail global array in message
- N DIFROM S U="^",XMSUB="Health Summary Info"
- S:$D(GMTSINST)&($L($G(GMTSBLD))) XMSUB="Health Summary "_GMTSBLD_" Install"
- S XMY("G.GMTS@ISC-SLC.DOMAIN.EXT")=""
- S XMTEXT="^TMP($J,""GMTSINFO"",",XMDUZ=.5 D ^XMD
- K ^TMP($J,"GMTSINFO"),%Z,XCNP,XMSCR,XMDUZ,XMY("G.GMTS@ISC-SLC.DOMAIN.EXT"),XMZ,XMSUB,XMY,XMTEXT,XMDUZ Q
- Q
- ;
- ; Temporary Global
- BL ; Blank Line
- N GMTSNX S GMTSNX=+($$NX),^TMP($J,"GMTSINFO",GMTSNX)="" Q
- TT(X) ; Title Line
- Q:'$L($G(X)) D TL(X) N GMTSBK S GMTSBK="===============================================================================",GMTSBK=$E(GMTSBK,1,$L($G(X))) D:$L(GMTSBK) TL(GMTSBK) Q
- TL(X) ; Text Line
- N GMTSNX S GMTSNX=+($$NX),^TMP($J,"GMTSINFO",GMTSNX)=$G(X) Q
- BK1 ; Break Line
- N GMTSNX S GMTSNX=+($$NX),^TMP($J,"GMTSINFO",GMTSNX)="-------------------------------------------------------------------------------" Q
- NX(X) ; Next Line #
- S (X,^TMP($J,"GMTSINFO",0))=+($G(^TMP($J,"GMTSINFO",0)))+1 Q X
- ST ; Show ^TMP($J,"GMTSINFO")
- N GMTSNN,GMTSNC S GMTSNN="^TMP("_$J_",""GMTSINFO"")",GMTSNC="^TMP("_$J_",""GMTSINFO"","
- F S GMTSNN=$Q(@GMTSNN) Q:GMTSNN=""!(GMTSNN'[GMTSNC) W:GMTSNN'[",0)" !,@GMTSNN
- Q
- ;
- DSP ; Display ^TMP($J,"GMTSINFO")
- D DEV Q
- DEV ; Select a device
- N %,%ZIS,IOP,ZTRTN,ZTSAVE,ZTDESC,ZTDTH,ZTIO,ZTSK
- S ZTRTN="DSPI^GMTSXPS1",ZTDESC="printing Health Summary install information"
- S ZTIO=ION,ZTDTH=$H,%ZIS="PQ",ZTSAVE("^TMP($J,""GMTSINFO"",")=""
- D ^%ZIS Q:POP S ZTIO=ION I $D(IO("Q")) D QUE,^%ZISC Q
- D NOQUE Q
- NOQUE ; Do not que task
- W @IOF W:IOST["P-" !,"< Not queued, printing Health Summary Info >",! H 2 U:IOST["P-" IO D @ZTRTN,^%ZISC Q
- QUE ; Task queued to print user defaults
- K IO("Q") D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued",1:"Request Cancelled"),! H 2 Q
- Q
- DSPI ; Display installation information
- I '$D(ZTQUEUED),$G(IOST)'["P-" I '$D(^TMP($J,"GMTSINFO")) W !,"Health Summary Installation not found"
- I IOST["P-" U IO
- G:'$D(^TMP($J,"GMTSINFO")) DSPQ
- N GMTSCONT,GMTSI,GMTSLC,GMTSEOP S GMTSCONT="",(GMTSLC,GMTSI)=0,GMTSEOP=+($G(IOSL)) S:GMTSEOP=0 GMTSEOP=24
- F S GMTSI=$O(^TMP($J,"GMTSINFO",GMTSI)) Q:+GMTSI=0!(GMTSCONT["^") D
- . W !,^TMP($J,"GMTSINFO",GMTSI) D LF Q:GMTSCONT["^"
- S:$D(ZTQUEUED) ZTREQ="@"
- W:$G(IOST)["P-" @IOF
- DSPQ ; Quit Display
- Q
- LF ; Line Feed
- S GMTSLC=GMTSLC+1 D:IOST["P-"&(GMTSLC>(GMTSEOP-7)) CONT D:IOST'["P-"&(GMTSLC>(GMTSEOP-4)) CONT
- Q
- CONT ; Page/Form Feed
- S GMTSLC=0 W:IOST["P-" @IOF Q:IOST["P-" W !!,"Press <Return> to continue " R GMTSCONT:300 S:'$T GMTSCONT="^" S:GMTSCONT'["^" GMTSCONT=""
- Q
- ;
- ; Miscellaneous
- TB(X) ; Tab
- S X=X F Q:$L(X)>19 S X=X_" "
- Q X
- PA(X) ; Remove Parenthesis
- Q $TR(X,"()","")
- LO(X) ; Lowercase
- Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
- UP(X) ; Uppercase
- Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- MX(X) ; Mixed Case
- Q $TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$TR($E(X,2,$L(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
- TRIM(X) ; Trim Space Characters
- S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
- F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
- Q X
- CLR ; Clean up
- K ^TMP($J,"GMTSINFO") Q
- NOW(X) ; Today's Date
- S X=$$EDT($$NOW^XLFDT) Q X
- EDT(X) ; External Date Foramt
- S X=+($G(X)) Q:X=0 "" S X=$$FMTE^XLFDT(+X,"5Z") S:X["@" X=$P(X,"@",1)_" "_$P(X,"@",2) Q X
- ROK(X) ; Routine OK (in UCI) (NDBI)
- S X=$G(X) Q:'$L(X) 0 Q:$L(X)>8 0 X ^%ZOSF("TEST") Q:$T 1 Q 0
- ENV(X) ; Environment check
- D HOME^%ZIS I '$D(^VA(200,+($G(DUZ)),0)) W !!," User (DUZ) not defined",! Q 0
- Q 1
- ENV2(X) ; Environment check
- D HOME^%ZIS I '$D(^VA(200,+($G(DUZ)),0)) Q 0
- Q 1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSXPS1 9919 printed Jan 18, 2025@03:02:13 Page 2
- GMTSXPS1 ; SLC/KER - Health Summary Status ; 08/27/2002
- +1 ;;2.7;Health Summary;**35,34,46,56**;Oct 20, 1995
- +2 ;
- +3 ; External References
- +4 ; DBIA 10086 HOME^%ZIS
- +5 ; DBIA 10086 ^%ZIS
- +6 ; DBIA 10089 ^%ZISC
- +7 ; DBIA 10063 ^%ZTLOAD
- +8 ; DBIA 10096 ^%ZOSF("UCI")
- +9 ; DBIA 10096 ^%ZOSF("PROD")
- +10 ; DBIA 10096 ^%ZOSF("TEST")
- +11 ; DBIA 10060 ^VA(200,
- +12 ; DBIA 2056 $$GET1^DIQ (file #4 and 200)
- +13 ; DBIA 1131 ^XMB("NETNAME")
- +14 ; DBIA 10091 ^XMB(1, file #4.3
- +15 ; DBIA 10070 ^XMD
- +16 ; DBIA 10103 $$NOW^XLFDT
- +17 ; DBIA 10103 $$FMTE^XLFDT
- +18 ;
- EN ; Display status only
- +1 NEW POP,GMTSENV
- SET GMTSENV=$$ENV
- if 'GMTSENV
- QUIT
- +2 KILL ^TMP($JOB,"GMTSINFO"),GMTSMAIL
- NEW X,Y,ZTSAVE
- DO HDR
- +3 if '$DATA(GMTSHORT)
- DO FI
- DO INS^GMTSXPS2
- DO OUTPUT
- QUIT
- SEND ; Send status to G.GMTS@ISC-SLC.DOMAIN.EXT
- +1 NEW POP,GMTSENV
- SET GMTSENV=$$ENV2
- if 'GMTSENV
- QUIT
- +2 SET GMTSIENS=$GET(GMTSIENS)
- if $LENGTH(GMTSIENS)
- SET GMTSIENS=";"_GMTSIENS_";"
- +3 SET GMTSENV=$$ROK("XMD")
- if 'GMTSENV
- QUIT
- KILL ^TMP($JOB,"GMTSINFO")
- NEW X,Y,ZTSAVE,ZTQUEUED,ZTREQ,ZTRTN
- +4 if $DATA(GMTSHORT)
- SET ZTSAVE("GMTSHORT")=""
- if $LENGTH($GET(GMTSBLD))
- SET ZTSAVE("GMTSBLD")=""
- if $DATA(GMTSINST)
- SET ZTSAVE("GMTSINST")=""
- if $LENGTH($GET(GMTSIENS))
- SET ZTSAVE("GMTSIENS")=""
- +5 SET ZTRTN="SENDTO^GMTSXPS1"
- SET ZTDESC="Health Summary Status Report Msg"
- SET ZTIO=""
- SET ZTDTH=$HOROLOG
- DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN
- QUIT
- SENDTO ; Send (Tasked)
- +1 NEW GMTSMAIL
- SET GMTSMAIL=""
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 NEW X,Y
- DO HDR
- if '$DATA(GMTSHORT)
- DO FI
- DO INS^GMTSXPS2
- DO OUTPUT
- QUIT
- +3 ;
- HDR ; Report Header
- +1 NEW X
- DO TITLE
- DO ASOF
- if $DATA(GMTSINST)
- DO MTBY
- DO INAC
- DO BLD
- DO BL
- +2 QUIT
- TITLE ; As of date
- +1 NEW X
- SET X=$SELECT($DATA(GMTSINST)&('$LENGTH($GET(GMTSBLD))):"Health Summary Installation",$DATA(GMTSINST)&($LENGTH($GET(GMTSBLD))):($GET(GMTSBLD)_" Installation"),1:"Health Summary Status")
- DO TT(X)
- DO BL
- QUIT
- ASOF ; As of date
- +1 NEW X
- SET X=$$NOW
- if $LENGTH(X)
- SET X=$$TB($SELECT($DATA(GMTSINST):" Installed on:",1:" As of:"))_X
- if $LENGTH(X)
- DO TL(X)
- QUIT
- INAC ; In Account
- +1 NEW X
- SET X=$$UCI($$U)
- if $LENGTH(X)
- SET X=$$TB(" Install Account:")_X
- if $LENGTH(X)
- DO TL(X)
- QUIT
- MTBY ; Maintained by
- +1 NEW X,Y
- SET X=$$P
- SET Y=$PIECE(X,"^",2)
- SET X=$PIECE(X,"^",1)
- if $LENGTH(X)
- SET X=$$TB($SELECT($DATA(GMTSINST):" Installed by:",1:" Maintained by:"))_X
- if $LENGTH(X)&($LENGTH(Y))
- SET X=X_" "_Y
- if $LENGTH(X)
- DO TL(X)
- QUIT
- BLD ; Install Build
- +1 if $DATA(GMTSINST)&($LENGTH($GET(GMTSBLD)))
- QUIT
- NEW X
- SET X=$GET(GMTSBLD)
- if '$LENGTH(X)
- QUIT
- if $LENGTH(X)
- SET X=$$TB(" Build:")_X
- if $LENGTH(X)
- DO TL(X)
- QUIT
- +2 ;
- FI ; Health Summary Files
- +1 if $DATA(GMTSHORT)
- QUIT
- +2 NEW X
- SET X=""
- SET X=X_$JUSTIFY("",37-$LENGTH(X))_" Total"
- SET X=X_$JUSTIFY("",48-$LENGTH(X))_"Last"
- DO TL(X)
- +3 SET X=" File"
- SET X=X_$JUSTIFY("",37-$LENGTH(X))_"Entries"
- SET X=X_$JUSTIFY("",48-$LENGTH(X))_"Entry"
- DO TL(X)
- +4 SET X=""
- SET $PIECE(X,"-",51)="-"
- SET X=" "_X
- DO TL(X)
- +5 DO F142
- DO F1421
- DO F14299
- DO BL
- +6 QUIT
- F142 ; Health Summary Type file 142
- +1 NEW X,GMTSA,GMTSAT,GMTSAP,GMTSL,GMTST,GMTSI
- SET X=" Health Summary Type"
- SET (GMTSL,GMTST,GMTSI)=0
- +2 FOR
- SET GMTSI=$ORDER(^GMT(142,GMTSI))
- if +GMTSI=0
- QUIT
- SET GMTSL=GMTSI
- SET GMTST=GMTST+1
- +3 SET X=X_$JUSTIFY("",32-$LENGTH(X))_$JUSTIFY(GMTST,10)
- SET X=X_$JUSTIFY("",42-$LENGTH(X))_$JUSTIFY(GMTSL,10)
- DO TL(X)
- +4 SET GMTSA=$ORDER(^GMT(142,"B","GMTS HS ADHOC OPTION",0))
- +5 SET X=" Ad Hoc Health Summary Type"
- SET (GMTSL,GMTST,GMTSI)=0
- +6 IF GMTSA=0
- SET X=X_$JUSTIFY("",37-$LENGTH(X))_"Missing Ad Hoc Health Summary Type"
- DO TL(X)
- QUIT
- +7 FOR
- SET GMTSI=$ORDER(^GMT(142,GMTSA,1,GMTSI))
- if +GMTSI=0
- QUIT
- SET GMTSL=GMTSI
- SET GMTST=GMTST+1
- +8 SET X=X_$JUSTIFY("",32-$LENGTH(X))_$JUSTIFY(GMTST,10)
- SET X=X_$JUSTIFY("",42-$LENGTH(X))_$JUSTIFY(GMTSL,10)
- if GMTSA'=12
- SET X=X_$JUSTIFY("",57-$LENGTH(X))_"Invalid IEN"
- DO TL(X)
- +9 QUIT
- F1421 ; Health Summary Component file 142.1
- +1 NEW X,GMTSA,GMTSAC,GMTSAT,GMTSAP,GMTSL,GMTST,GMTSE,GMTSI
- +2 SET X=" Health Summary Component"
- SET (GMTSAT,GMTSAP,GMTSAC,GMTSL,GMTST,GMTSI,GMTSE)=0
- +3 FOR
- SET GMTSI=$ORDER(^GMT(142.1,GMTSI))
- if +GMTSI=0
- QUIT
- Begin DoDot:1
- +4 SET GMTSL=GMTSI
- SET GMTST=GMTST+1
- if GMTSI<501
- SET GMTSE=GMTSE+1
- +5 SET GMTSA=$PIECE($GET(^GMT(142.1,GMTSI,0)),"^",6)
- if GMTSA="T"
- SET GMTSAT=+($GET(GMTSAT))+1
- if GMTSA="P"
- SET GMTSAP=+($GET(GMTSAP))+1
- if GMTSA=""
- SET GMTSAC=+($GET(GMTSAC))+1
- End DoDot:1
- +6 SET X=X_$JUSTIFY("",32-$LENGTH(X))_$JUSTIFY(GMTST,10)
- SET X=X_$JUSTIFY("",42-$LENGTH(X))_$JUSTIFY(GMTSL,10)
- DO TL(X)
- +7 IF +($GET(GMTSE))>0
- SET X=" Exported"
- SET X=X_$JUSTIFY("",32-$LENGTH(X))_$JUSTIFY(GMTSE,10)
- DO TL(X)
- +8 IF +($GET(GMTSAT))>0
- SET X=" Temporarily Disabled"
- SET X=X_$JUSTIFY("",32-$LENGTH(X))_$JUSTIFY(GMTSAT,10)
- DO TL(X)
- +9 IF +($GET(GMTSAP))>0
- SET X=" Permanently Disabled"
- SET X=X_$JUSTIFY("",32-$LENGTH(X))_$JUSTIFY(GMTSAP,10)
- DO TL(X)
- +10 IF +($GET(GMTSAC))>0&(+($GET(GMTSAC))'=+($GET(GMTST)))
- SET X=" Active Components"
- SET X=X_$JUSTIFY("",32-$LENGTH(X))_$JUSTIFY(GMTSAC,10)
- DO TL(X)
- +11 DO STA^GMTSXPS3
- +12 QUIT
- F14299 ; Health Summary Parameter file 142.9
- +1 NEW X,GMTSA,GMTSL,GMTST,GMTSI
- SET X=" Health Summary Parameters"
- SET (GMTSL,GMTST,GMTSI)=0
- +2 FOR
- SET GMTSI=$ORDER(^GMT(142.99,GMTSI))
- if +GMTSI=0
- QUIT
- SET GMTSL=GMTSI
- SET GMTST=GMTST+1
- +3 SET X=X_$JUSTIFY("",32-$LENGTH(X))_$JUSTIFY(GMTST,10)
- SET X=X_$JUSTIFY("",42-$LENGTH(X))_$JUSTIFY(GMTSL,10)
- DO TL(X)
- +4 QUIT
- +5 ;
- +6 ; Retrieve Data
- U(X) ; UCI where Health Summary is installed
- +1 NEW GMTSU,GMTSP,GMTST
- SET GMTST=$GET(X)
- XECUTE ^%ZOSF("UCI")
- SET GMTSU=Y
- +2 if Y=^%ZOSF("PROD")
- SET GMTSP=" (Production)"
- if Y'=^%ZOSF("PROD")
- SET GMTSP=" (Test)"
- if GMTSU["DEM"
- SET GMTSP=" (Demo)"
- +3 SET X=""
- SET $PIECE(X,"^",1)=GMTSU
- SET $PIECE(X,"^",2)=GMTSP
- QUIT X
- UCI(X) ; UCI Format
- +1 SET X=$GET(X)
- NEW GMTSA,GMTST
- SET GMTSA=$PIECE(X,"^",1)
- SET GMTST=$PIECE(X,"^",2)
- if $LENGTH(GMTST)
- SET GMTST=$$MX($$TRIM($$PA(GMTST)))
- +2 if $LENGTH($PIECE(GMTSA,",",1))=3&($LENGTH($PIECE(GMTSA,",",2))=3)
- SET GMTSA="["_GMTSA_"]"
- if $LENGTH(GMTSA)&($LENGTH(GMTST))
- SET GMTST="("_GMTST_")"
- +3 SET X=""
- if $LENGTH(GMTSA)
- SET X=GMTSA
- if $LENGTH(X)&($LENGTH(GMTST))
- SET X=X_" "_GMTST
- if '$LENGTH(X)&($LENGTH(GMTST))
- SET X=GMTST
- +4 QUIT X
- P(X) ; Person
- +1 SET X=+($GET(DUZ))
- if '$LENGTH($PIECE($GET(^VA(200,+($GET(X)),0)),"^",1))
- QUIT "UNKNOWN^"
- +2 NEW GMTSDUZ,GMTSPH
- SET GMTSDUZ=+($GET(DUZ))
- +3 SET GMTSPH=$PIECE($GET(^VA(200,GMTSDUZ,.13)),"^",2)
- if GMTSPH=""
- SET GMTSPH=$PIECE($GET(^VA(200,GMTSDUZ,.13)),"^",1)
- if GMTSPH=""
- SET GMTSPH=$PIECE($GET(^VA(200,GMTSDUZ,.13)),"^",3)
- if GMTSPH=""
- SET GMTSPH=$PIECE($GET(^VA(200,GMTSDUZ,.13)),"^",4)
- +4 SET GMTSDUZ=$PIECE(^VA(200,GMTSDUZ,0),"^",1)
- SET X=GMTSDUZ_"^"_GMTSPH
- QUIT X
- INST(X) ; Institution
- +1 SET X=$GET(^XMB("NETNAME"))
- IF $LENGTH(X)
- if X[".DOMAIN.EXT"
- SET X=$PIECE(X,".DOMAIN.EXT",1)
- if X["."
- SET X=$PIECE(X,".",$LENGTH(X,"."))
- QUIT X
- +2 SET X=$PIECE($GET(^XMB(1,1,"XUS")),"^",17)
- IF +X>0
- SET X=$$GET1^DIQ(4,+X,.01,"E")
- if $LENGTH(X)
- QUIT X
- +3 SET X=""
- QUIT X
- +4 ;
- OUTPUT ; Show global array (display or mail)
- +1 if $DATA(GMTSMAIL)
- DO MAIL
- DO CLR
- if '$DATA(GMTSMAIL)
- DO DSP
- DO CLR
- QUIT
- DISPLAY ; Display global array
- +1 NEW GMTSI
- SET GMTSI=0
- FOR
- SET GMTSI=$ORDER(^TMP($JOB,"GMTSINFO",GMTSI))
- if +GMTSI=0
- QUIT
- Begin DoDot:1
- +2 WRITE !,^TMP($JOB,"GMTSINFO",GMTSI)
- End DoDot:1
- +3 QUIT
- MAIL ; Mail global array in message
- +1 NEW DIFROM
- SET U="^"
- SET XMSUB="Health Summary Info"
- +2 if $DATA(GMTSINST)&($LENGTH($GET(GMTSBLD)))
- SET XMSUB="Health Summary "_GMTSBLD_" Install"
- +3 SET XMY("G.GMTS@ISC-SLC.DOMAIN.EXT")=""
- +4 SET XMTEXT="^TMP($J,""GMTSINFO"","
- SET XMDUZ=.5
- DO ^XMD
- +5 KILL ^TMP($JOB,"GMTSINFO"),%Z,XCNP,XMSCR,XMDUZ,XMY("G.GMTS@ISC-SLC.DOMAIN.EXT"),XMZ,XMSUB,XMY,XMTEXT,XMDUZ
- QUIT
- +6 QUIT
- +7 ;
- +8 ; Temporary Global
- BL ; Blank Line
- +1 NEW GMTSNX
- SET GMTSNX=+($$NX)
- SET ^TMP($JOB,"GMTSINFO",GMTSNX)=""
- QUIT
- TT(X) ; Title Line
- +1 if '$LENGTH($GET(X))
- QUIT
- DO TL(X)
- NEW GMTSBK
- SET GMTSBK="==============================================================================="
- SET GMTSBK=$EXTRACT(GMTSBK,1,$LENGTH($GET(X)))
- if $LENGTH(GMTSBK)
- DO TL(GMTSBK)
- QUIT
- TL(X) ; Text Line
- +1 NEW GMTSNX
- SET GMTSNX=+($$NX)
- SET ^TMP($JOB,"GMTSINFO",GMTSNX)=$GET(X)
- QUIT
- BK1 ; Break Line
- +1 NEW GMTSNX
- SET GMTSNX=+($$NX)
- SET ^TMP($JOB,"GMTSINFO",GMTSNX)="-------------------------------------------------------------------------------"
- QUIT
- NX(X) ; Next Line #
- +1 SET (X,^TMP($JOB,"GMTSINFO",0))=+($GET(^TMP($JOB,"GMTSINFO",0)))+1
- QUIT X
- ST ; Show ^TMP($J,"GMTSINFO")
- +1 NEW GMTSNN,GMTSNC
- SET GMTSNN="^TMP("_$JOB_",""GMTSINFO"")"
- SET GMTSNC="^TMP("_$JOB_",""GMTSINFO"","
- +2 FOR
- SET GMTSNN=$QUERY(@GMTSNN)
- if GMTSNN=""!(GMTSNN'[GMTSNC)
- QUIT
- if GMTSNN'[",0)"
- WRITE !,@GMTSNN
- +3 QUIT
- +4 ;
- DSP ; Display ^TMP($J,"GMTSINFO")
- +1 DO DEV
- QUIT
- DEV ; Select a device
- +1 NEW %,%ZIS,IOP,ZTRTN,ZTSAVE,ZTDESC,ZTDTH,ZTIO,ZTSK
- +2 SET ZTRTN="DSPI^GMTSXPS1"
- SET ZTDESC="printing Health Summary install information"
- +3 SET ZTIO=ION
- SET ZTDTH=$HOROLOG
- SET %ZIS="PQ"
- SET ZTSAVE("^TMP($J,""GMTSINFO"",")=""
- +4 DO ^%ZIS
- if POP
- QUIT
- SET ZTIO=ION
- IF $DATA(IO("Q"))
- DO QUE
- DO ^%ZISC
- QUIT
- +5 DO NOQUE
- QUIT
- NOQUE ; Do not que task
- +1 WRITE @IOF
- if IOST["P-"
- WRITE !,"< Not queued, printing Health Summary Info >",!
- HANG 2
- if IOST["P-"
- USE IO
- DO @ZTRTN
- DO ^%ZISC
- QUIT
- QUE ; Task queued to print user defaults
- +1 KILL IO("Q")
- DO ^%ZTLOAD
- WRITE !,$SELECT($DATA(ZTSK):"Request Queued",1:"Request Cancelled"),!
- HANG 2
- QUIT
- +2 QUIT
- DSPI ; Display installation information
- +1 IF '$DATA(ZTQUEUED)
- IF $GET(IOST)'["P-"
- IF '$DATA(^TMP($JOB,"GMTSINFO"))
- WRITE !,"Health Summary Installation not found"
- +2 IF IOST["P-"
- USE IO
- +3 if '$DATA(^TMP($JOB,"GMTSINFO"))
- GOTO DSPQ
- +4 NEW GMTSCONT,GMTSI,GMTSLC,GMTSEOP
- SET GMTSCONT=""
- SET (GMTSLC,GMTSI)=0
- SET GMTSEOP=+($GET(IOSL))
- if GMTSEOP=0
- SET GMTSEOP=24
- +5 FOR
- SET GMTSI=$ORDER(^TMP($JOB,"GMTSINFO",GMTSI))
- if +GMTSI=0!(GMTSCONT["^")
- QUIT
- Begin DoDot:1
- +6 WRITE !,^TMP($JOB,"GMTSINFO",GMTSI)
- DO LF
- if GMTSCONT["^"
- QUIT
- End DoDot:1
- +7 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +8 if $GET(IOST)["P-"
- WRITE @IOF
- DSPQ ; Quit Display
- +1 QUIT
- LF ; Line Feed
- +1 SET GMTSLC=GMTSLC+1
- if IOST["P-"&(GMTSLC>(GMTSEOP-7))
- DO CONT
- if IOST'["P-"&(GMTSLC>(GMTSEOP-4))
- DO CONT
- +2 QUIT
- CONT ; Page/Form Feed
- +1 SET GMTSLC=0
- if IOST["P-"
- WRITE @IOF
- if IOST["P-"
- QUIT
- WRITE !!,"Press <Return> to continue "
- READ GMTSCONT:300
- if '$TEST
- SET GMTSCONT="^"
- if GMTSCONT'["^"
- SET GMTSCONT=""
- +2 QUIT
- +3 ;
- +4 ; Miscellaneous
- TB(X) ; Tab
- +1 SET X=X
- FOR
- if $LENGTH(X)>19
- QUIT
- SET X=X_" "
- +2 QUIT X
- PA(X) ; Remove Parenthesis
- +1 QUIT $TRANSLATE(X,"()","")
- LO(X) ; Lowercase
- +1 QUIT $TRANSLATE(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
- UP(X) ; Uppercase
- +1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- MX(X) ; Mixed Case
- +1 QUIT $TRANSLATE($EXTRACT(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$TRANSLATE($EXTRACT(X,2,$LENGTH(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
- TRIM(X) ; Trim Space Characters
- +1 SET X=$GET(X)
- FOR
- if $EXTRACT(X,1)'=" "
- QUIT
- SET X=$EXTRACT(X,2,$LENGTH(X))
- +2 FOR
- if $EXTRACT(X,$LENGTH(X))'=" "
- QUIT
- SET X=$EXTRACT(X,1,($LENGTH(X)-1))
- +3 QUIT X
- CLR ; Clean up
- +1 KILL ^TMP($JOB,"GMTSINFO")
- QUIT
- NOW(X) ; Today's Date
- +1 SET X=$$EDT($$NOW^XLFDT)
- QUIT X
- EDT(X) ; External Date Foramt
- +1 SET X=+($GET(X))
- if X=0
- QUIT ""
- SET X=$$FMTE^XLFDT(+X,"5Z")
- if X["@"
- SET X=$PIECE(X,"@",1)_" "_$PIECE(X,"@",2)
- QUIT X
- ROK(X) ; Routine OK (in UCI) (NDBI)
- +1 SET X=$GET(X)
- if '$LENGTH(X)
- QUIT 0
- if $LENGTH(X)>8
- QUIT 0
- XECUTE ^%ZOSF("TEST")
- if $TEST
- QUIT 1
- QUIT 0
- ENV(X) ; Environment check
- +1 DO HOME^%ZIS
- IF '$DATA(^VA(200,+($GET(DUZ)),0))
- WRITE !!," User (DUZ) not defined",!
- QUIT 0
- +2 QUIT 1
- ENV2(X) ; Environment check
- +1 DO HOME^%ZIS
- IF '$DATA(^VA(200,+($GET(DUZ)),0))
- QUIT 0
- +2 QUIT 1