XBEHRCK ;IHS/SET/GTH - EHR ENVIRONMENT CHECK ; [ 05/11/2004 ]
;;1.0;IHS ELECTRONIC HEALTH RECORD;;May 12, 2004
;
; To add to the list of requirements, add the info specific to the
; application after the "ENV" label, below in the form:
; Namespace*Version*Patch
; E.g., to check for Pt Reg, v 6.1, patch 2:
; AG*6.1*2
; If the application has no patches, leave the patch info blank.
; 20040512d
; 20040603 IHS/SET/HMW Added checks for Pharmacy Data Management
; 20040615 Changed ABSP to check for patch 10 instead of 8
; 20040708 Removed SD patch 63
; 20040719 Removed SD Patches 300 307 314
; Removed HL Patches 17 18 21 8 9
; Removed GMTS Patch 45
; Removed ABSP Patch 10
; Removed APSE 6.1
;
ENV ; Namespace*Version*Patch
;;XU*8.0*1010
;;XU*8.0*2
;;XU*8.0*15
;;XU*8.0*16
;;XU*8.0*26
;;XU*8.0*28
;;XU*8.0*32
;;XU*8.0*44
;;XU*8.0*311
;;XU*8.0*288
;;XT*7.3*1002
;;XT*7.3*73
;;DI*22.0*1001
;;DI*22.0*70
;;HL*1.6*1005
;;PSO*6.0*5
;;APSA*6.1
;;AUPN*99.1*11
;;LEX*2*9
;;VSIT*2
;;PX*1*45
;;PX*1*73
;;PX*1*74
;;PX*1*88
;;PX*1*115
;;PXRM*1.5*1
;;PXRM*1.5*2
;;PXRM*1.5*3
;;PXRM*1.5*4
;;PXRM*1.5*5
;;PXRM*1.5*6
;;PXRM*1.5*7
;;PXRM*1.5*8
;;PXRM*1.5*9
;;PXRM*1.5*10
;;PXRM*1.5*11
;;PXRM*1.5*13
;;PXRM*1.5*14
;;PXRM*1.5*17
;;PXRM*1.5*15
;;PXRM*1.5*19
;;GMTS*2.7*36
;;GMTS*2.7*43
;;GMTS*2.7*52
;;GMTS*2.7*60
;;GMTS*2.7*62
;;GMTS*2.7*64
;;GMTS*2.7*68
;;PIMS*5.3T11
;;DG*5.3*124
;;DG*5.3*57
;;DG*5.3*134
;;DG*5.3*249
;;DG*5.3*265
;;DG*5.3*276
;;DG*5.3*277
;;DG*5.3*389
;;DG*5.3*415
;;SD*5.3*131 SEQ #127
;;SD*5.3*263 SEQ #243
;;SD*5.3*254 SEQ #247
;;USR*1.0
;;TIU*1.0*1 SEQ #4
;;TIU*1.0*3 SEQ #5
;;TIU*1.0*4 SEQ #8
;;TIU*1.0*7 SEQ #9
;;TIU*1.0*15 SEQ #10
;;TIU*1.0*19 SEQ #19
;;TIU*1.0*28 SEQ #22
;;TIU*1.0*31 SEQ #34
;;TIU*1.0*47 SEQ #60
;;TIU*1.0*76 SEQ #70
;;TIU*1.0*80 SEQ #82
;;TIU*1.0*102 SEQ #86
;;TIU*1.0*89 SEQ #90
;;TIU*1.0*108 SEQ #99
;;TIU*1.0*170
;;TIU*1.0*150 SEQ #142
;;TIU*1.0*100 SEQ #103
;;TIU*1.0*105 SEQ #106
;;TIU*1.0*119 SEQ #109
;;TIU*1.0*125 SEQ #113
;;TIU*1.0*127 SEQ #118
;;TIU*1.0*122 SEQ #119
;;TIU*1.0*124 SEQ #124
;;TIU*1.0*138 SEQ #125
;;TIU*1.0*63 SEQ #76
;;TIU*1.0*137
;;TIU*1.0*134
;;TIU*1.0*109 SEQ #123
;;LR*5.2*1018
;;LR*5.2*128
;;LR*5.2*121
;;LR*5.2*201
;;LR*5.2*191
;;LR*5.2*208
;;RA*5.0
;;PSJ*4.5
;;BW*2.0
;;BW*2.0*9
;;XWB*1.1*6
;;XWB*1.1*12
;;END; <-- Leave this alone. It's the LOOP ender.
; -----------------------------------------------------
;
; begin - FOR TEST ONLY REMOVE FOR DIST.
;I '$G(DUZ) D
;. KILL
;. KILL ^XUTL("XQ",$J)
;. D HOME^%ZIS,DT^DICRW,^XBKTMP
;. S DUZ=1,DUZ(2)=$P(^AUTTSITE(1,0),U)
;.Q
; end - FOR TEST ONLY REMOVE FOR DIST.
;
I '$G(DUZ) D RSLT(""),RSLT("Please set your DUZ before running this routine.") Q
D DT^DICRW,^XBKVAR
D ASKDEV Q:POP
Q:$D(ZTQUEUED)
;
ZTM ;EP - Taskman entry point
KILL ^TMP("XBEHRCK",$J)
NEW XBEH,XBEHNEED,XBEHOK
N XBEHNS,XBEHNAME,XBEHVER,XBEHPKG,XBEHC
U IO
S XBEHOK=1,XBEHC=0
S XBEHPKG=""
S X=$P(^VA(200,DUZ,0),U)
;
D RSLT(""),RSLT("Hello, "_$P(X,",",2)_" "_$P(X,","))
D RSLT(""),RSLT("Environment Checker for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_", as of "_$P($T(+2),";",6)_".")
;
F XBEH=1:1 Q:$P($T(ENV+XBEH),";",3)="END" D
. S XBEH(0)=$P($T(ENV+XBEH),";",3)
. S XBEHNS=$P(XBEH(0),"*")
. Q:XBEHNS=""
. S XBEHVER=$P(XBEH(0),"*",2)
. S XBEHNAME=$O(^DIC(9.4,"C",XBEHNS,0))
. S:XBEHNAME]"" XBEHNAME=$G(^DIC(9.4,XBEHNAME,0))
. S:XBEHNAME]"" XBEHNAME=$P(XBEHNAME,U)
. D VCHK(XBEHNS,XBEHVER,XBEHNAME)
. D RSLT("")
. Q
;
D RXCK
D RSLT(""),RSLT("ENVIRONMENT "_$S(XBEHOK:"",1:"-NOT- ")_"OK.")
I 'XBEHOK D
. D RSLT("INSTALL THE FOLLOWING PACKAGES AND PATCHES:")
. S XBEHNEED=""
. F S XBEHNEED=$O(XBEHNEED(XBEHNEED)) Q:'$L(XBEHNEED) D RSLT(XBEHNEED)
.Q
;
D POST
;
Q
RXCK ;
;
N PS S PS=$P($G(^PS(59.7,1,80)),U,2)
I 'PS D
. S XBEHMSG="The Pharmacy Data Management package must be installed, and the Orderable Item Auto Create run to completion."
. D RSLT(XBEHMSG)
. S XBEHNEED("Pharmacy Data Management")=""
I PS=1 D
. S XBEHMSG="The Orderable Item Auto Create in Pharmacy Data Management package must be run to completion."
. D RSLT(XBEHMSG)
. S XBEHNEED("Pharmacy Data Management Orderable Item Auto Create")=""
I PS=2 D
. S XBEHMSG="The Manual Matching Process for Orderable Items in Pharmacy Data Management package has not been completed."
. D RSLT(XBEHMSG)
. S XBEHNEED("Pharmacy Data Management Manual Matching Process must be completed.")=""
I $P($G(^PS(59.7,1,80)),"^",3)'=3 D
. S XBEHMSG="Pharmacy Dosage Conversion is not complete."
. D RSLT(XBEHMSG)
. S XBEHNEED("Pharmacy Dosage Conversion must be completed.")=""
Q
;
VCHK(XBEHPRE,XBEHVER,XBEHNAME) ; -----------------------------------------------------
; Check versions needed.
; Modifies XBEHNEED
;
NEW XBEHV,XBEHMSG
I XBEHNAME'=XBEHPKG D
. D RSLT("")
. S XBEHPKG=XBEHNAME
. S XBEHV=$$VERSION^XPDUTL(XBEHPRE)
. S XBEHMSG=XBEHNAME_$S(XBEHNAME]"":":",1:"")_" Need at least "_XBEHPRE_" v "_XBEHVER
. I +XBEHV S XBEHMSG=XBEHMSG_"....."_XBEHPRE_" v "_XBEHV_" is installed."
. E S XBEHMSG=XBEHMSG_"....."_XBEHPRE_" is not installed."
. D RSLT(XBEHMSG)
. I XBEHV<XBEHVER D Q
. . S XBEHOK=0,XBEHMSG=""
. . S XBEHMSG=$S(+XBEHV:"Upgrade ",1:"Install ")
. . S XBEHMSG=" "_XBEHMSG_XBEHPRE_" v "_XBEHVER_"."
. . D RSLT(XBEHMSG)
. . S XBEHNEED(XBEH(0))=""
. .Q
Q:'$P(XBEH(0),"*",3)
D PCHK(XBEH(0))
Q
;
PCHK(XBEH) ; -----------------------------------------------------
; Determine if patch XBEH was installed, where XBEH is
; the name of the INSTALL. E.g "AVA*93.2*12".
;
D RSLT(" Need Patch '"_XBEH)
NEW DIC,X,Y
; lookup package.
S X=$P(XBEH,"*",1)
S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
D IX^DIC
I Y<1 D Q
. D RSLT(" Failed lookup for Namespace '"_X_"' in PACKAGE file.")
. S XBEHOK=0,XBEHNEED(XBEH)=""
. D DUPCHK(X)
.Q
; lookup version.
S DIC=DIC_+Y_",22,",X=$P(XBEH,"*",2)
D ^DIC
I Y<1 D RSLT(" Failed lookup for version '"_X_"' in PACKAGE file.") S XBEHOK=0,XBEHNEED(XBEH)="" Q
; lookup patch.
S DIC=DIC_+Y_",""PAH"",",X=$P(XBEH,"*",3)
D ^DIC
I Y<1 D RSLT(" Failed lookup for patch '"_X_"' in PACKAGE file.") S XBEHOK=0,XBEHNEED(XBEH)="" Q
D RSLT(" Patch '"_XBEH_"' IS installed.")
Q
DUPCHK(X) ; -----------------------------------------------------
; Check PACKAGE file for duplicate entries of namespace X.
;
NEW DA,DIC
S DIC="^DIC(9.4,",DIC(0)="",D="C"
D IX^DIC
Q:Y>0
Q:'$D(^DIC(9.4,"C",X))
D RSLT(" You Have More Than One Entry In The")
D RSLT(" PACKAGE File with an "_X_" prefix.")
D RSLT(" One entry needs to be deleted.")
Q
POST ; -----------------------------------------------------
NEW XMSUB,XMDUZ,XMTEXT,XMY
S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$G(DUZ,.5),XMTEXT="^TMP(""XBEHRCK"",$J,",XMY(1)="",XMY(DUZ)=""
D SINGLE("XUPROGMODE")
NEW DIFROM
D ^XMD
KILL ^TMP("XBEHRCK",$J)
D RSLT("")
D RSLT("The results are in your MailMan 'IN' basket.")
Q
; -----------------------------------------------------
SINGLE(K) ; Get holders of a single key K.
NEW Y
S Y=0
Q:'$D(^XUSEC(K))
F S Y=$O(^XUSEC(K,Y)) Q:'Y S XMY(Y)=""
Q
; -----------------------------------------------------
RSLT(%) ;S ^(0)=$G(^TMP("XBEHRCK",$J,0))+1,^(^(0))=%
;More readable:
S ^TMP("XBEHRCK",$J,0)=$G(^TMP("XBEHRCK",$J,0))+1
S ^TMP("XBEHRCK",$J,^TMP("XBEHRCK",$J,0))=%
W !,%
Q
;
ASKDEV ;EP
K IOP
S %ZIS="NQ" D ^%ZIS Q:POP
S IOP=ION
S %ZIS("IOPAR")=IOPAR
I $D(IO("Q")) D QUE I '$D(ZTQUEUED) K IOP G ASKDEV
I $D(IO("Q")) D HOME^%ZIS W !,"REPORT IS QUEUED!"
Q
;
QUE ;
S ZTRTN="ZTM^XBEHRCK",ZTDESC="EHR ENVIRONMENT CHECK"
S ZTSAVE("IOP")=""
D ^%ZTLOAD
Q
XBEHRCK ;IHS/SET/GTH - EHR ENVIRONMENT CHECK ; [ 05/11/2004 ]
+1 ;;1.0;IHS ELECTRONIC HEALTH RECORD;;May 12, 2004
+2 ;
+3 ; To add to the list of requirements, add the info specific to the
+4 ; application after the "ENV" label, below in the form:
+5 ; Namespace*Version*Patch
+6 ; E.g., to check for Pt Reg, v 6.1, patch 2:
+7 ; AG*6.1*2
+8 ; If the application has no patches, leave the patch info blank.
+9 ; 20040512d
+10 ; 20040603 IHS/SET/HMW Added checks for Pharmacy Data Management
+11 ; 20040615 Changed ABSP to check for patch 10 instead of 8
+12 ; 20040708 Removed SD patch 63
+13 ; 20040719 Removed SD Patches 300 307 314
+14 ; Removed HL Patches 17 18 21 8 9
+15 ; Removed GMTS Patch 45
+16 ; Removed ABSP Patch 10
+17 ; Removed APSE 6.1
+18 ;
ENV ; Namespace*Version*Patch
+1 ;;XU*8.0*1010
+2 ;;XU*8.0*2
+3 ;;XU*8.0*15
+4 ;;XU*8.0*16
+5 ;;XU*8.0*26
+6 ;;XU*8.0*28
+7 ;;XU*8.0*32
+8 ;;XU*8.0*44
+9 ;;XU*8.0*311
+10 ;;XU*8.0*288
+11 ;;XT*7.3*1002
+12 ;;XT*7.3*73
+13 ;;DI*22.0*1001
+14 ;;DI*22.0*70
+15 ;;HL*1.6*1005
+16 ;;PSO*6.0*5
+17 ;;APSA*6.1
+18 ;;AUPN*99.1*11
+19 ;;LEX*2*9
+20 ;;VSIT*2
+21 ;;PX*1*45
+22 ;;PX*1*73
+23 ;;PX*1*74
+24 ;;PX*1*88
+25 ;;PX*1*115
+26 ;;PXRM*1.5*1
+27 ;;PXRM*1.5*2
+28 ;;PXRM*1.5*3
+29 ;;PXRM*1.5*4
+30 ;;PXRM*1.5*5
+31 ;;PXRM*1.5*6
+32 ;;PXRM*1.5*7
+33 ;;PXRM*1.5*8
+34 ;;PXRM*1.5*9
+35 ;;PXRM*1.5*10
+36 ;;PXRM*1.5*11
+37 ;;PXRM*1.5*13
+38 ;;PXRM*1.5*14
+39 ;;PXRM*1.5*17
+40 ;;PXRM*1.5*15
+41 ;;PXRM*1.5*19
+42 ;;GMTS*2.7*36
+43 ;;GMTS*2.7*43
+44 ;;GMTS*2.7*52
+45 ;;GMTS*2.7*60
+46 ;;GMTS*2.7*62
+47 ;;GMTS*2.7*64
+48 ;;GMTS*2.7*68
+49 ;;PIMS*5.3T11
+50 ;;DG*5.3*124
+51 ;;DG*5.3*57
+52 ;;DG*5.3*134
+53 ;;DG*5.3*249
+54 ;;DG*5.3*265
+55 ;;DG*5.3*276
+56 ;;DG*5.3*277
+57 ;;DG*5.3*389
+58 ;;DG*5.3*415
+59 ;;SD*5.3*131 SEQ #127
+60 ;;SD*5.3*263 SEQ #243
+61 ;;SD*5.3*254 SEQ #247
+62 ;;USR*1.0
+63 ;;TIU*1.0*1 SEQ #4
+64 ;;TIU*1.0*3 SEQ #5
+65 ;;TIU*1.0*4 SEQ #8
+66 ;;TIU*1.0*7 SEQ #9
+67 ;;TIU*1.0*15 SEQ #10
+68 ;;TIU*1.0*19 SEQ #19
+69 ;;TIU*1.0*28 SEQ #22
+70 ;;TIU*1.0*31 SEQ #34
+71 ;;TIU*1.0*47 SEQ #60
+72 ;;TIU*1.0*76 SEQ #70
+73 ;;TIU*1.0*80 SEQ #82
+74 ;;TIU*1.0*102 SEQ #86
+75 ;;TIU*1.0*89 SEQ #90
+76 ;;TIU*1.0*108 SEQ #99
+77 ;;TIU*1.0*170
+78 ;;TIU*1.0*150 SEQ #142
+79 ;;TIU*1.0*100 SEQ #103
+80 ;;TIU*1.0*105 SEQ #106
+81 ;;TIU*1.0*119 SEQ #109
+82 ;;TIU*1.0*125 SEQ #113
+83 ;;TIU*1.0*127 SEQ #118
+84 ;;TIU*1.0*122 SEQ #119
+85 ;;TIU*1.0*124 SEQ #124
+86 ;;TIU*1.0*138 SEQ #125
+87 ;;TIU*1.0*63 SEQ #76
+88 ;;TIU*1.0*137
+89 ;;TIU*1.0*134
+90 ;;TIU*1.0*109 SEQ #123
+91 ;;LR*5.2*1018
+92 ;;LR*5.2*128
+93 ;;LR*5.2*121
+94 ;;LR*5.2*201
+95 ;;LR*5.2*191
+96 ;;LR*5.2*208
+97 ;;RA*5.0
+98 ;;PSJ*4.5
+99 ;;BW*2.0
+100 ;;BW*2.0*9
+101 ;;XWB*1.1*6
+102 ;;XWB*1.1*12
+103 ;;END; <-- Leave this alone. It's the LOOP ender.
+104 ; -----------------------------------------------------
+105 ;
+106 ; begin - FOR TEST ONLY REMOVE FOR DIST.
+107 ;I '$G(DUZ) D
+108 ;. KILL
+109 ;. KILL ^XUTL("XQ",$J)
+110 ;. D HOME^%ZIS,DT^DICRW,^XBKTMP
+111 ;. S DUZ=1,DUZ(2)=$P(^AUTTSITE(1,0),U)
+112 ;.Q
+113 ; end - FOR TEST ONLY REMOVE FOR DIST.
+114 ;
+115 IF '$GET(DUZ)
DO RSLT("")
DO RSLT("Please set your DUZ before running this routine.")
QUIT
+116 DO DT^DICRW
DO ^XBKVAR
+117 DO ASKDEV
IF POP
QUIT
+118 IF $DATA(ZTQUEUED)
QUIT
+119 ;
ZTM ;EP - Taskman entry point
+1 KILL ^TMP("XBEHRCK",$JOB)
+2 NEW XBEH,XBEHNEED,XBEHOK
+3 NEW XBEHNS,XBEHNAME,XBEHVER,XBEHPKG,XBEHC
+4 USE IO
+5 SET XBEHOK=1
SET XBEHC=0
+6 SET XBEHPKG=""
+7 SET X=$PIECE(^VA(200,DUZ,0),U)
+8 ;
+9 DO RSLT("")
DO RSLT("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","))
+10 DO RSLT("")
DO RSLT("Environment Checker for "_$PIECE($TEXT(+2),";",4)_" V "_$PIECE($TEXT(+2),";",3)_", as of "_$PIECE($TEXT(+2),";",6)_".")
+11 ;
+12 FOR XBEH=1:1
IF $PIECE($TEXT(ENV+XBEH),";",3)="END"
QUIT
Begin DoDot:1
+13 SET XBEH(0)=$PIECE($TEXT(ENV+XBEH),";",3)
+14 SET XBEHNS=$PIECE(XBEH(0),"*")
+15 IF XBEHNS=""
QUIT
+16 SET XBEHVER=$PIECE(XBEH(0),"*",2)
+17 SET XBEHNAME=$ORDER(^DIC(9.4,"C",XBEHNS,0))
+18 IF XBEHNAME]""
SET XBEHNAME=$GET(^DIC(9.4,XBEHNAME,0))
+19 IF XBEHNAME]""
SET XBEHNAME=$PIECE(XBEHNAME,U)
+20 DO VCHK(XBEHNS,XBEHVER,XBEHNAME)
+21 DO RSLT("")
+22 QUIT
End DoDot:1
+23 ;
+24 DO RXCK
+25 DO RSLT("")
DO RSLT("ENVIRONMENT "_$SELECT(XBEHOK:"",1:"-NOT- ")_"OK.")
+26 IF 'XBEHOK
Begin DoDot:1
+27 DO RSLT("INSTALL THE FOLLOWING PACKAGES AND PATCHES:")
+28 SET XBEHNEED=""
+29 FOR
SET XBEHNEED=$ORDER(XBEHNEED(XBEHNEED))
IF '$LENGTH(XBEHNEED)
QUIT
DO RSLT(XBEHNEED)
+30 QUIT
End DoDot:1
+31 ;
+32 DO POST
+33 ;
+34 QUIT
RXCK ;
+1 ;
+2 NEW PS
SET PS=$PIECE($GET(^PS(59.7,1,80)),U,2)
+3 IF 'PS
Begin DoDot:1
+4 SET XBEHMSG="The Pharmacy Data Management package must be installed, and the Orderable Item Auto Create run to completion."
+5 DO RSLT(XBEHMSG)
+6 SET XBEHNEED("Pharmacy Data Management")=""
End DoDot:1
+7 IF PS=1
Begin DoDot:1
+8 SET XBEHMSG="The Orderable Item Auto Create in Pharmacy Data Management package must be run to completion."
+9 DO RSLT(XBEHMSG)
+10 SET XBEHNEED("Pharmacy Data Management Orderable Item Auto Create")=""
End DoDot:1
+11 IF PS=2
Begin DoDot:1
+12 SET XBEHMSG="The Manual Matching Process for Orderable Items in Pharmacy Data Management package has not been completed."
+13 DO RSLT(XBEHMSG)
+14 SET XBEHNEED("Pharmacy Data Management Manual Matching Process must be completed.")=""
End DoDot:1
+15 IF $PIECE($GET(^PS(59.7,1,80)),"^",3)'=3
Begin DoDot:1
+16 SET XBEHMSG="Pharmacy Dosage Conversion is not complete."
+17 DO RSLT(XBEHMSG)
+18 SET XBEHNEED("Pharmacy Dosage Conversion must be completed.")=""
End DoDot:1
+19 QUIT
+20 ;
VCHK(XBEHPRE,XBEHVER,XBEHNAME) ; -----------------------------------------------------
+1 ; Check versions needed.
+2 ; Modifies XBEHNEED
+3 ;
+4 NEW XBEHV,XBEHMSG
+5 IF XBEHNAME'=XBEHPKG
Begin DoDot:1
+6 DO RSLT("")
+7 SET XBEHPKG=XBEHNAME
+8 SET XBEHV=$$VERSION^XPDUTL(XBEHPRE)
+9 SET XBEHMSG=XBEHNAME_$SELECT(XBEHNAME]"":":",1:"")_" Need at least "_XBEHPRE_" v "_XBEHVER
+10 IF +XBEHV
SET XBEHMSG=XBEHMSG_"....."_XBEHPRE_" v "_XBEHV_" is installed."
+11 IF '$TEST
SET XBEHMSG=XBEHMSG_"....."_XBEHPRE_" is not installed."
+12 DO RSLT(XBEHMSG)
+13 IF XBEHV<XBEHVER
Begin DoDot:2
+14 SET XBEHOK=0
SET XBEHMSG=""
+15 SET XBEHMSG=$SELECT(+XBEHV:"Upgrade ",1:"Install ")
+16 SET XBEHMSG=" "_XBEHMSG_XBEHPRE_" v "_XBEHVER_"."
+17 DO RSLT(XBEHMSG)
+18 SET XBEHNEED(XBEH(0))=""
+19 QUIT
End DoDot:2
QUIT
End DoDot:1
+20 IF '$PIECE(XBEH(0),"*",3)
QUIT
+21 DO PCHK(XBEH(0))
+22 QUIT
+23 ;
PCHK(XBEH) ; -----------------------------------------------------
+1 ; Determine if patch XBEH was installed, where XBEH is
+2 ; the name of the INSTALL. E.g "AVA*93.2*12".
+3 ;
+4 DO RSLT(" Need Patch '"_XBEH)
+5 NEW DIC,X,Y
+6 ; lookup package.
+7 SET X=$PIECE(XBEH,"*",1)
+8 SET DIC="^DIC(9.4,"
SET DIC(0)="FM"
SET D="C"
+9 DO IX^DIC
+10 IF Y<1
Begin DoDot:1
+11 DO RSLT(" Failed lookup for Namespace '"_X_"' in PACKAGE file.")
+12 SET XBEHOK=0
SET XBEHNEED(XBEH)=""
+13 DO DUPCHK(X)
+14 QUIT
End DoDot:1
QUIT
+15 ; lookup version.
+16 SET DIC=DIC_+Y_",22,"
SET X=$PIECE(XBEH,"*",2)
+17 DO ^DIC
+18 IF Y<1
DO RSLT(" Failed lookup for version '"_X_"' in PACKAGE file.")
SET XBEHOK=0
SET XBEHNEED(XBEH)=""
QUIT
+19 ; lookup patch.
+20 SET DIC=DIC_+Y_",""PAH"","
SET X=$PIECE(XBEH,"*",3)
+21 DO ^DIC
+22 IF Y<1
DO RSLT(" Failed lookup for patch '"_X_"' in PACKAGE file.")
SET XBEHOK=0
SET XBEHNEED(XBEH)=""
QUIT
+23 DO RSLT(" Patch '"_XBEH_"' IS installed.")
+24 QUIT
DUPCHK(X) ; -----------------------------------------------------
+1 ; Check PACKAGE file for duplicate entries of namespace X.
+2 ;
+3 NEW DA,DIC
+4 SET DIC="^DIC(9.4,"
SET DIC(0)=""
SET D="C"
+5 DO IX^DIC
+6 IF Y>0
QUIT
+7 IF '$DATA(^DIC(9.4,"C",X))
QUIT
+8 DO RSLT(" You Have More Than One Entry In The")
+9 DO RSLT(" PACKAGE File with an "_X_" prefix.")
+10 DO RSLT(" One entry needs to be deleted.")
+11 QUIT
POST ; -----------------------------------------------------
+1 NEW XMSUB,XMDUZ,XMTEXT,XMY
+2 SET XMSUB=$PIECE($PIECE($TEXT(+1),";",2)," ",3,99)
SET XMDUZ=$GET(DUZ,.5)
SET XMTEXT="^TMP(""XBEHRCK"",$J,"
SET XMY(1)=""
SET XMY(DUZ)=""
+3 DO SINGLE("XUPROGMODE")
+4 NEW DIFROM
+5 DO ^XMD
+6 KILL ^TMP("XBEHRCK",$JOB)
+7 DO RSLT("")
+8 DO RSLT("The results are in your MailMan 'IN' basket.")
+9 QUIT
+10 ; -----------------------------------------------------
SINGLE(K) ; Get holders of a single key K.
+1 NEW Y
+2 SET Y=0
+3 IF '$DATA(^XUSEC(K))
QUIT
+4 FOR
SET Y=$ORDER(^XUSEC(K,Y))
IF 'Y
QUIT
SET XMY(Y)=""
+5 QUIT
+6 ; -----------------------------------------------------
RSLT(%) ;S ^(0)=$G(^TMP("XBEHRCK",$J,0))+1,^(^(0))=%
+1 ;More readable:
+2 SET ^TMP("XBEHRCK",$JOB,0)=$GET(^TMP("XBEHRCK",$JOB,0))+1
+3 SET ^TMP("XBEHRCK",$JOB,^TMP("XBEHRCK",$JOB,0))=%
+4 WRITE !,%
+5 QUIT
+6 ;
ASKDEV ;EP
+1 KILL IOP
+2 SET %ZIS="NQ"
DO ^%ZIS
IF POP
QUIT
+3 SET IOP=ION
+4 SET %ZIS("IOPAR")=IOPAR
+5 IF $DATA(IO("Q"))
DO QUE
IF '$DATA(ZTQUEUED)
KILL IOP
GOTO ASKDEV
+6 IF $DATA(IO("Q"))
DO HOME^%ZIS
WRITE !,"REPORT IS QUEUED!"
+7 QUIT
+8 ;
QUE ;
+1 SET ZTRTN="ZTM^XBEHRCK"
SET ZTDESC="EHR ENVIRONMENT CHECK"
+2 SET ZTSAVE("IOP")=""
+3 DO ^%ZTLOAD
+4 QUIT
