| 1 | GMTSXPS1 ; SLC/KER - Health Summary Status ; 08/27/2002
|
|---|
| 2 | ;;2.7;Health Summary;**35,34,46,56**;Oct 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 10086 HOME^%ZIS
|
|---|
| 6 | ; DBIA 10086 ^%ZIS
|
|---|
| 7 | ; DBIA 10089 ^%ZISC
|
|---|
| 8 | ; DBIA 10063 ^%ZTLOAD
|
|---|
| 9 | ; DBIA 10096 ^%ZOSF("UCI")
|
|---|
| 10 | ; DBIA 10096 ^%ZOSF("PROD")
|
|---|
| 11 | ; DBIA 10096 ^%ZOSF("TEST")
|
|---|
| 12 | ; DBIA 10060 ^VA(200,
|
|---|
| 13 | ; DBIA 2056 $$GET1^DIQ (file #4 and 200)
|
|---|
| 14 | ; DBIA 1131 ^XMB("NETNAME")
|
|---|
| 15 | ; DBIA 10091 ^XMB(1, file #4.3
|
|---|
| 16 | ; DBIA 10070 ^XMD
|
|---|
| 17 | ; DBIA 10103 $$NOW^XLFDT
|
|---|
| 18 | ; DBIA 10103 $$FMTE^XLFDT
|
|---|
| 19 | ;
|
|---|
| 20 | EN ; Display status only
|
|---|
| 21 | N POP,GMTSENV S GMTSENV=$$ENV Q:'GMTSENV
|
|---|
| 22 | K ^TMP($J,"GMTSINFO"),GMTSMAIL N X,Y,ZTSAVE D HDR
|
|---|
| 23 | D:'$D(GMTSHORT) FI,INS^GMTSXPS2 D OUTPUT Q
|
|---|
| 24 | SEND ; Send status to G.GMTS@ISC-SLC.VA.GOV
|
|---|
| 25 | N POP,GMTSENV S GMTSENV=$$ENV2 Q:'GMTSENV
|
|---|
| 26 | S GMTSIENS=$G(GMTSIENS) S:$L(GMTSIENS) GMTSIENS=";"_GMTSIENS_";"
|
|---|
| 27 | S GMTSENV=$$ROK("XMD") Q:'GMTSENV K ^TMP($J,"GMTSINFO") N X,Y,ZTSAVE,ZTQUEUED,ZTREQ,ZTRTN
|
|---|
| 28 | S:$D(GMTSHORT) ZTSAVE("GMTSHORT")="" S:$L($G(GMTSBLD)) ZTSAVE("GMTSBLD")="" S:$D(GMTSINST) ZTSAVE("GMTSINST")="" S:$L($G(GMTSIENS)) ZTSAVE("GMTSIENS")=""
|
|---|
| 29 | 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
|
|---|
| 30 | SENDTO ; Send (Tasked)
|
|---|
| 31 | N GMTSMAIL S GMTSMAIL="" S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 32 | N X,Y D HDR D:'$D(GMTSHORT) FI,INS^GMTSXPS2 D OUTPUT Q
|
|---|
| 33 | ;
|
|---|
| 34 | HDR ; Report Header
|
|---|
| 35 | N X D TITLE,ASOF D:$D(GMTSINST) MTBY D INAC,BLD D BL
|
|---|
| 36 | Q
|
|---|
| 37 | TITLE ; As of date
|
|---|
| 38 | 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
|
|---|
| 39 | ASOF ; As of date
|
|---|
| 40 | 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
|
|---|
| 41 | INAC ; In Account
|
|---|
| 42 | N X S X=$$UCI($$U) S:$L(X) X=$$TB(" Install Account:")_X D:$L(X) TL(X) Q
|
|---|
| 43 | MTBY ; Maintained by
|
|---|
| 44 | 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
|
|---|
| 45 | BLD ; Install Build
|
|---|
| 46 | 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
|
|---|
| 47 | ;
|
|---|
| 48 | FI ; Health Summary Files
|
|---|
| 49 | Q:$D(GMTSHORT)
|
|---|
| 50 | N X S X="",X=X_$J("",37-$L(X))_" Total",X=X_$J("",48-$L(X))_"Last" D TL(X)
|
|---|
| 51 | S X=" File",X=X_$J("",37-$L(X))_"Entries",X=X_$J("",48-$L(X))_"Entry" D TL(X)
|
|---|
| 52 | S X="",$P(X,"-",51)="-",X=" "_X D TL(X)
|
|---|
| 53 | D F142,F1421,F14299,BL
|
|---|
| 54 | Q
|
|---|
| 55 | F142 ; Health Summary Type file 142
|
|---|
| 56 | N X,GMTSA,GMTSAT,GMTSAP,GMTSL,GMTST,GMTSI S X=" Health Summary Type",(GMTSL,GMTST,GMTSI)=0
|
|---|
| 57 | F S GMTSI=$O(^GMT(142,GMTSI)) Q:+GMTSI=0 S GMTSL=GMTSI,GMTST=GMTST+1
|
|---|
| 58 | S X=X_$J("",32-$L(X))_$J(GMTST,10),X=X_$J("",42-$L(X))_$J(GMTSL,10) D TL(X)
|
|---|
| 59 | S GMTSA=$O(^GMT(142,"B","GMTS HS ADHOC OPTION",0))
|
|---|
| 60 | S X=" Ad Hoc Health Summary Type",(GMTSL,GMTST,GMTSI)=0
|
|---|
| 61 | I GMTSA=0 S X=X_$J("",37-$L(X))_"Missing Ad Hoc Health Summary Type" D TL(X) Q
|
|---|
| 62 | F S GMTSI=$O(^GMT(142,GMTSA,1,GMTSI)) Q:+GMTSI=0 S GMTSL=GMTSI,GMTST=GMTST+1
|
|---|
| 63 | 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)
|
|---|
| 64 | Q
|
|---|
| 65 | F1421 ; Health Summary Component file 142.1
|
|---|
| 66 | N X,GMTSA,GMTSAC,GMTSAT,GMTSAP,GMTSL,GMTST,GMTSE,GMTSI
|
|---|
| 67 | S X=" Health Summary Component",(GMTSAT,GMTSAP,GMTSAC,GMTSL,GMTST,GMTSI,GMTSE)=0
|
|---|
| 68 | F S GMTSI=$O(^GMT(142.1,GMTSI)) Q:+GMTSI=0 D
|
|---|
| 69 | . S GMTSL=GMTSI,GMTST=GMTST+1 S:GMTSI<501 GMTSE=GMTSE+1
|
|---|
| 70 | . 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
|
|---|
| 71 | S X=X_$J("",32-$L(X))_$J(GMTST,10),X=X_$J("",42-$L(X))_$J(GMTSL,10) D TL(X)
|
|---|
| 72 | I +($G(GMTSE))>0 S X=" Exported",X=X_$J("",32-$L(X))_$J(GMTSE,10) D TL(X)
|
|---|
| 73 | I +($G(GMTSAT))>0 S X=" Temporarily Disabled",X=X_$J("",32-$L(X))_$J(GMTSAT,10) D TL(X)
|
|---|
| 74 | I +($G(GMTSAP))>0 S X=" Permanently Disabled",X=X_$J("",32-$L(X))_$J(GMTSAP,10) D TL(X)
|
|---|
| 75 | I +($G(GMTSAC))>0&(+($G(GMTSAC))'=+($G(GMTST))) S X=" Active Components",X=X_$J("",32-$L(X))_$J(GMTSAC,10) D TL(X)
|
|---|
| 76 | D STA^GMTSXPS3
|
|---|
| 77 | Q
|
|---|
| 78 | F14299 ; Health Summary Parameter file 142.9
|
|---|
| 79 | N X,GMTSA,GMTSL,GMTST,GMTSI S X=" Health Summary Parameters",(GMTSL,GMTST,GMTSI)=0
|
|---|
| 80 | F S GMTSI=$O(^GMT(142.99,GMTSI)) Q:+GMTSI=0 S GMTSL=GMTSI,GMTST=GMTST+1
|
|---|
| 81 | S X=X_$J("",32-$L(X))_$J(GMTST,10),X=X_$J("",42-$L(X))_$J(GMTSL,10) D TL(X)
|
|---|
| 82 | Q
|
|---|
| 83 | ;
|
|---|
| 84 | ; Retrieve Data
|
|---|
| 85 | U(X) ; UCI where Health Summary is installed
|
|---|
| 86 | N GMTSU,GMTSP,GMTST S GMTST=$G(X) X ^%ZOSF("UCI") S GMTSU=Y
|
|---|
| 87 | S:Y=^%ZOSF("PROD") GMTSP=" (Production)" S:Y'=^%ZOSF("PROD") GMTSP=" (Test)" S:GMTSU["DEM" GMTSP=" (Demo)"
|
|---|
| 88 | S X="",$P(X,"^",1)=GMTSU,$P(X,"^",2)=GMTSP Q X
|
|---|
| 89 | UCI(X) ; UCI Format
|
|---|
| 90 | S X=$G(X) N GMTSA,GMTST S GMTSA=$P(X,"^",1),GMTST=$P(X,"^",2) S:$L(GMTST) GMTST=$$MX($$TRIM($$PA(GMTST)))
|
|---|
| 91 | S:$L($P(GMTSA,",",1))=3&($L($P(GMTSA,",",2))=3) GMTSA="["_GMTSA_"]" S:$L(GMTSA)&($L(GMTST)) GMTST="("_GMTST_")"
|
|---|
| 92 | S X="" S:$L(GMTSA) X=GMTSA S:$L(X)&($L(GMTST)) X=X_" "_GMTST S:'$L(X)&($L(GMTST)) X=GMTST
|
|---|
| 93 | Q X
|
|---|
| 94 | P(X) ; Person
|
|---|
| 95 | S X=+($G(DUZ)) Q:'$L($P($G(^VA(200,+($G(X)),0)),"^",1)) "UNKNOWN^"
|
|---|
| 96 | N GMTSDUZ,GMTSPH S GMTSDUZ=+($G(DUZ))
|
|---|
| 97 | 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)
|
|---|
| 98 | S GMTSDUZ=$P(^VA(200,GMTSDUZ,0),"^",1),X=GMTSDUZ_"^"_GMTSPH Q X
|
|---|
| 99 | INST(X) ; Institution
|
|---|
| 100 | S X=$G(^XMB("NETNAME")) I $L(X) S:X[".VA.GOV" X=$P(X,".VA.GOV",1) S:X["." X=$P(X,".",$L(X,".")) Q X
|
|---|
| 101 | S X=$P($G(^XMB(1,1,"XUS")),"^",17) I +X>0 S X=$$GET1^DIQ(4,+X,.01,"E") Q:$L(X) X
|
|---|
| 102 | S X="" Q X
|
|---|
| 103 | ;
|
|---|
| 104 | OUTPUT ; Show global array (display or mail)
|
|---|
| 105 | D:$D(GMTSMAIL) MAIL,CLR D:'$D(GMTSMAIL) DSP,CLR Q
|
|---|
| 106 | DISPLAY ; Display global array
|
|---|
| 107 | N GMTSI S GMTSI=0 F S GMTSI=$O(^TMP($J,"GMTSINFO",GMTSI)) Q:+GMTSI=0 D
|
|---|
| 108 | . W !,^TMP($J,"GMTSINFO",GMTSI)
|
|---|
| 109 | Q
|
|---|
| 110 | MAIL ; Mail global array in message
|
|---|
| 111 | N DIFROM S U="^",XMSUB="Health Summary Info"
|
|---|
| 112 | S:$D(GMTSINST)&($L($G(GMTSBLD))) XMSUB="Health Summary "_GMTSBLD_" Install"
|
|---|
| 113 | S XMY("G.GMTS@ISC-SLC.VA.GOV")=""
|
|---|
| 114 | S XMTEXT="^TMP($J,""GMTSINFO"",",XMDUZ=.5 D ^XMD
|
|---|
| 115 | K ^TMP($J,"GMTSINFO"),%Z,XCNP,XMSCR,XMDUZ,XMY("G.GMTS@ISC-SLC.VA.GOV"),XMZ,XMSUB,XMY,XMTEXT,XMDUZ Q
|
|---|
| 116 | Q
|
|---|
| 117 | ;
|
|---|
| 118 | ; Temporary Global
|
|---|
| 119 | BL ; Blank Line
|
|---|
| 120 | N GMTSNX S GMTSNX=+($$NX),^TMP($J,"GMTSINFO",GMTSNX)="" Q
|
|---|
| 121 | TT(X) ; Title Line
|
|---|
| 122 | Q:'$L($G(X)) D TL(X) N GMTSBK S GMTSBK="===============================================================================",GMTSBK=$E(GMTSBK,1,$L($G(X))) D:$L(GMTSBK) TL(GMTSBK) Q
|
|---|
| 123 | TL(X) ; Text Line
|
|---|
| 124 | N GMTSNX S GMTSNX=+($$NX),^TMP($J,"GMTSINFO",GMTSNX)=$G(X) Q
|
|---|
| 125 | BK1 ; Break Line
|
|---|
| 126 | N GMTSNX S GMTSNX=+($$NX),^TMP($J,"GMTSINFO",GMTSNX)="-------------------------------------------------------------------------------" Q
|
|---|
| 127 | NX(X) ; Next Line #
|
|---|
| 128 | S (X,^TMP($J,"GMTSINFO",0))=+($G(^TMP($J,"GMTSINFO",0)))+1 Q X
|
|---|
| 129 | ST ; Show ^TMP($J,"GMTSINFO")
|
|---|
| 130 | N GMTSNN,GMTSNC S GMTSNN="^TMP("_$J_",""GMTSINFO"")",GMTSNC="^TMP("_$J_",""GMTSINFO"","
|
|---|
| 131 | F S GMTSNN=$Q(@GMTSNN) Q:GMTSNN=""!(GMTSNN'[GMTSNC) W:GMTSNN'[",0)" !,@GMTSNN
|
|---|
| 132 | Q
|
|---|
| 133 | ;
|
|---|
| 134 | DSP ; Display ^TMP($J,"GMTSINFO")
|
|---|
| 135 | D DEV Q
|
|---|
| 136 | DEV ; Select a device
|
|---|
| 137 | N %,%ZIS,IOP,ZTRTN,ZTSAVE,ZTDESC,ZTDTH,ZTIO,ZTSK
|
|---|
| 138 | S ZTRTN="DSPI^GMTSXPS1",ZTDESC="printing Health Summary install information"
|
|---|
| 139 | S ZTIO=ION,ZTDTH=$H,%ZIS="PQ",ZTSAVE("^TMP($J,""GMTSINFO"",")=""
|
|---|
| 140 | D ^%ZIS Q:POP S ZTIO=ION I $D(IO("Q")) D QUE,^%ZISC Q
|
|---|
| 141 | D NOQUE Q
|
|---|
| 142 | NOQUE ; Do not que task
|
|---|
| 143 | W @IOF W:IOST["P-" !,"< Not queued, printing Health Summary Info >",! H 2 U:IOST["P-" IO D @ZTRTN,^%ZISC Q
|
|---|
| 144 | QUE ; Task queued to print user defaults
|
|---|
| 145 | K IO("Q") D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued",1:"Request Cancelled"),! H 2 Q
|
|---|
| 146 | Q
|
|---|
| 147 | DSPI ; Display installation information
|
|---|
| 148 | I '$D(ZTQUEUED),$G(IOST)'["P-" I '$D(^TMP($J,"GMTSINFO")) W !,"Health Summary Installation not found"
|
|---|
| 149 | I IOST["P-" U IO
|
|---|
| 150 | G:'$D(^TMP($J,"GMTSINFO")) DSPQ
|
|---|
| 151 | N GMTSCONT,GMTSI,GMTSLC,GMTSEOP S GMTSCONT="",(GMTSLC,GMTSI)=0,GMTSEOP=+($G(IOSL)) S:GMTSEOP=0 GMTSEOP=24
|
|---|
| 152 | F S GMTSI=$O(^TMP($J,"GMTSINFO",GMTSI)) Q:+GMTSI=0!(GMTSCONT["^") D
|
|---|
| 153 | . W !,^TMP($J,"GMTSINFO",GMTSI) D LF Q:GMTSCONT["^"
|
|---|
| 154 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 155 | W:$G(IOST)["P-" @IOF
|
|---|
| 156 | DSPQ ; Quit Display
|
|---|
| 157 | Q
|
|---|
| 158 | LF ; Line Feed
|
|---|
| 159 | S GMTSLC=GMTSLC+1 D:IOST["P-"&(GMTSLC>(GMTSEOP-7)) CONT D:IOST'["P-"&(GMTSLC>(GMTSEOP-4)) CONT
|
|---|
| 160 | Q
|
|---|
| 161 | CONT ; Page/Form Feed
|
|---|
| 162 | S GMTSLC=0 W:IOST["P-" @IOF Q:IOST["P-" W !!,"Press <Return> to continue " R GMTSCONT:300 S:'$T GMTSCONT="^" S:GMTSCONT'["^" GMTSCONT=""
|
|---|
| 163 | Q
|
|---|
| 164 | ;
|
|---|
| 165 | ; Miscellaneous
|
|---|
| 166 | TB(X) ; Tab
|
|---|
| 167 | S X=X F Q:$L(X)>19 S X=X_" "
|
|---|
| 168 | Q X
|
|---|
| 169 | PA(X) ; Remove Parenthesis
|
|---|
| 170 | Q $TR(X,"()","")
|
|---|
| 171 | LO(X) ; Lowercase
|
|---|
| 172 | Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
|
|---|
| 173 | UP(X) ; Uppercase
|
|---|
| 174 | Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
| 175 | MX(X) ; Mixed Case
|
|---|
| 176 | Q $TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$TR($E(X,2,$L(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
|
|---|
| 177 | TRIM(X) ; Trim Space Characters
|
|---|
| 178 | S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
|
|---|
| 179 | F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
|
|---|
| 180 | Q X
|
|---|
| 181 | CLR ; Clean up
|
|---|
| 182 | K ^TMP($J,"GMTSINFO") Q
|
|---|
| 183 | NOW(X) ; Today's Date
|
|---|
| 184 | S X=$$EDT($$NOW^XLFDT) Q X
|
|---|
| 185 | EDT(X) ; External Date Foramt
|
|---|
| 186 | S X=+($G(X)) Q:X=0 "" S X=$$FMTE^XLFDT(+X,"5Z") S:X["@" X=$P(X,"@",1)_" "_$P(X,"@",2) Q X
|
|---|
| 187 | ROK(X) ; Routine OK (in UCI) (NDBI)
|
|---|
| 188 | S X=$G(X) Q:'$L(X) 0 Q:$L(X)>8 0 X ^%ZOSF("TEST") Q:$T 1 Q 0
|
|---|
| 189 | ENV(X) ; Environment check
|
|---|
| 190 | D HOME^%ZIS I '$D(^VA(200,+($G(DUZ)),0)) W !!," User (DUZ) not defined",! Q 0
|
|---|
| 191 | Q 1
|
|---|
| 192 | ENV2(X) ; Environment check
|
|---|
| 193 | D HOME^%ZIS I '$D(^VA(200,+($G(DUZ)),0)) Q 0
|
|---|
| 194 | Q 1
|
|---|
