Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XBEHRCK

XBEHRCK.m

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