AG7P2 ;IHS/SD/EFG - Patient Registration 7.0 Patch 2 ENVIRONMENT CHECKER ; [ 05/08/2003 1:14 PM ]
;;7.0;IHS PATIENT REGISTRATION;**1,2,3**;MAR 28, 2003
;
;
I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q
;
I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q
;
S X=$P(^VA(200,DUZ,0),U)
W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_" Patch "_$P($T(+2),";",5)_".",IOM),!
;
NEW AGQUIT
S AGQUIT=0
I '$$VCHK("AG","7.0",2) S AGQUIT=2
;
I '$$VCHK("AUPN","99.1",2) S AGQUIT=2
;
;S X=$$LAST^XPDUTL("IHS DICTIONARIES (PATIENT)","99.1")
S X=$$LAST^AG7P2("IHS DICTIONARIES (PATIENT)","99.1")
I $P(X,U,1)'=12&($P(X,U,1)'>12) W !,$$CJ^XLFSTR("AUPN v99.1 Patch 12 NOT INSTALLED",IOM) S AGQUIT=2
;
I '$$VCHK("AUT","98.1",2) S AGQUIT=2
;
;S X=$$LAST^XPDUTL("IHS DICTIONARIES (POINTERS)","98.1")
S X=$$LAST^AG7P2("IHS DICTIONARIES (POINTERS)","98.1")
I $P(X,U,1)'=13&($P(X,U,1)'>13) W !,$$CJ^XLFSTR("AUT v98.1 Patch 13 NOT INSTALLED",IOM) S AGQUIT=2
;
NEW DA,DIC
S X="AG",DIC="^DIC(9.4,",DIC(0)="",D="C"
D IX^DIC
I Y<0,$D(^DIC(9.4,"C","AG")) D S AGQUIT=2
. W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AG"" prefix.",IOM)
. W !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
. W !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
.Q
;
I $G(XPDENV)=1 D
. ; The following line prevents the "Disable Options..." and "Move
. ; Routines..." questions from being asked during the install.
. S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
. D OPTSAV("AGMENU")
.Q
;
I AGQUIT D SORRY(AGQUIT) Q
;
W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
;
I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2) Q
Q
;
SORRY(X) ;
KILL DIFQ
S XPDQUIT=X
W:'$D(ZTQUEUED) *7,!,$$CJ^XLFSTR("Sorry....",IOM),$$DIR^XBDIR("E","Press RETURN")
Q
;
VCHK(AGPRE,AGVER,AGQUIT) ; Check versions needed.
;
NEW AGV
S AGV=$$VERSION^XPDUTL(AGPRE)
W !,$$CJ^XLFSTR("Need at least "_AGPRE_" v "_AGVER_"....."_AGPRE_" v "_AGV_" Present",IOM)
I AGV<AGVER W *7,!,$$CJ^XLFSTR("^^^^**NEEDS FIXED**^^^^",IOM) Q 0
Q 1
;
OPTSAV(AGM) ;
D BMES^XPDUTL("Saving the configuration of option '"_AGM_"'...")
I $D(^XTMP("AG7P2",7.2,"OPTSAV",AGM)) D BMES^XPDUTL("NOT SAVED. Option '"_AGM_"' has previously been saved.") Q
I '$D(^XTMP("AG7P2")) S ^XTMP("AG7P2",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"AG7P2 - SAVE OPTION CONFIGURATIONS."
NEW I,A
S I=$O(^DIC(19,"B",AGM,0))
I 'I D BMES^XPDUTL("NOT SAVED. Option '"_AGM_"' not found in OPTION file.") Q
S A=0
F S A=$O(^DIC(19,I,10,A)) Q:'A S ^XTMP("AG7P2",7.2,"OPTSAV",AGM,A)=$P(^DIC(19,+^DIC(19,I,10,A,0),0),U,1)_U_$P(^DIC(19,I,10,A,0),U,2,3)
Q
;
INSTALLD(AGINSTAL) ;EP - Determine if patch AGINSTAL was installed, where AGINSTAL is
; the name of the INSTALL. E.g "AG*6.0*10".
;;^DIC(9.4,D0,22,D1,PAH,D2,0)=
;;(#.01) PATCH APPLICATION HISTORY [1F] ^ (#.02)DATE APPLIED [2D] ^ (#.03) APPLIED BY [3P] ^
NEW DIC,X,Y
S X=$P(AGINSTAL,"*",1)
S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
D IX^DIC
I Y<1 Q 0
S DIC=DIC_+Y_",22,",X=$P(AGINSTAL,"*",2)
D ^DIC
I Y<1 Q 0
S DIC=DIC_+Y_",""PAH"",",X=$P(AGINSTAL,"*",3)
D ^DIC
Q $S(Y<1:0,1:1)
;
LAST(PKG,VER) ;returns last patch applied for a Package, PATCH^DATE
; Patch includes Seq # if Released
N PKGIEN,VERIEN,LATEST,PATCH,SUBIEN
I $G(VER)="" S VER=$$VERSION^XPDUTL(PKG) Q:'VER -1
S PKGIEN=$O(^DIC(9.4,"B",PKG,"")) Q:'PKGIEN -1
S VERIEN=$O(^DIC(9.4,PKGIEN,22,"B",VER,"")) Q:'VERIEN -1
S LATEST=-1,PATCH=-1,SUBIEN=0
F S SUBIEN=$O(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN)) Q:SUBIEN'>0 D
. I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST S LATEST=$P(^(0),U,2),PATCH=$P(^(0),U)
Q PATCH_U_LATEST
AG7P2 ;IHS/SD/EFG - Patient Registration 7.0 Patch 2 ENVIRONMENT CHECKER ; [ 05/08/2003 1:14 PM ]
+1 ;;7.0;IHS PATIENT REGISTRATION;**1,2,3**;MAR 28, 2003
+2 ;
+3 ;
+4 IF '$GET(DUZ)
WRITE !,"DUZ UNDEFINED OR 0."
DO SORRY(2)
QUIT
+5 ;
+6 IF '$LENGTH($GET(DUZ(0)))
WRITE !,"DUZ(0) UNDEFINED OR NULL."
DO SORRY(2)
QUIT
+7 ;
+8 SET X=$PIECE(^VA(200,DUZ,0),U)
+9 WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)
+10 WRITE !!,$$CJ^XLFSTR("Checking Environment for "_$PIECE($TEXT(+2),";",4)_" V "_$PIECE($TEXT(+2),";",3)_" Patch "_$PIECE($TEXT(+2),";",5)_".",IOM),!
+11 ;
+12 NEW AGQUIT
+13 SET AGQUIT=0
+14 IF '$$VCHK("AG","7.0",2)
SET AGQUIT=2
+15 ;
+16 IF '$$VCHK("AUPN","99.1",2)
SET AGQUIT=2
+17 ;
+18 ;S X=$$LAST^XPDUTL("IHS DICTIONARIES (PATIENT)","99.1")
+19 SET X=$$LAST^AG7P2("IHS DICTIONARIES (PATIENT)","99.1")
+20 IF $PIECE(X,U,1)'=12&($PIECE(X,U,1)'>12)
WRITE !,$$CJ^XLFSTR("AUPN v99.1 Patch 12 NOT INSTALLED",IOM)
SET AGQUIT=2
+21 ;
+22 IF '$$VCHK("AUT","98.1",2)
SET AGQUIT=2
+23 ;
+24 ;S X=$$LAST^XPDUTL("IHS DICTIONARIES (POINTERS)","98.1")
+25 SET X=$$LAST^AG7P2("IHS DICTIONARIES (POINTERS)","98.1")
+26 IF $PIECE(X,U,1)'=13&($PIECE(X,U,1)'>13)
WRITE !,$$CJ^XLFSTR("AUT v98.1 Patch 13 NOT INSTALLED",IOM)
SET AGQUIT=2
+27 ;
+28 NEW DA,DIC
+29 SET X="AG"
SET DIC="^DIC(9.4,"
SET DIC(0)=""
SET D="C"
+30 DO IX^DIC
+31 IF Y<0
IF $DATA(^DIC(9.4,"C","AG"))
Begin DoDot:1
+32 WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AG"" prefix.",IOM)
+33 WRITE !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
+34 WRITE !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
+35 QUIT
End DoDot:1
SET AGQUIT=2
+36 ;
+37 IF $GET(XPDENV)=1
Begin DoDot:1
+38 ; The following line prevents the "Disable Options..." and "Move
+39 ; Routines..." questions from being asked during the install.
+40 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+41 DO OPTSAV("AGMENU")
+42 QUIT
End DoDot:1
+43 ;
+44 IF AGQUIT
DO SORRY(AGQUIT)
QUIT
+45 ;
+46 WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
+47 ;
+48 IF '$$DIR^XBDIR("E","","","","","",1)
DO SORRY(2)
QUIT
+49 QUIT
+50 ;
SORRY(X) ;
+1 KILL DIFQ
+2 SET XPDQUIT=X
+3 IF '$DATA(ZTQUEUED)
WRITE *7,!,$$CJ^XLFSTR("Sorry....",IOM),$$DIR^XBDIR("E","Press RETURN")
+4 QUIT
+5 ;
VCHK(AGPRE,AGVER,AGQUIT) ; Check versions needed.
+1 ;
+2 NEW AGV
+3 SET AGV=$$VERSION^XPDUTL(AGPRE)
+4 WRITE !,$$CJ^XLFSTR("Need at least "_AGPRE_" v "_AGVER_"....."_AGPRE_" v "_AGV_" Present",IOM)
+5 IF AGV<AGVER
WRITE *7,!,$$CJ^XLFSTR("^^^^**NEEDS FIXED**^^^^",IOM)
QUIT 0
+6 QUIT 1
+7 ;
OPTSAV(AGM) ;
+1 DO BMES^XPDUTL("Saving the configuration of option '"_AGM_"'...")
+2 IF $DATA(^XTMP("AG7P2",7.2,"OPTSAV",AGM))
DO BMES^XPDUTL("NOT SAVED. Option '"_AGM_"' has previously been saved.")
QUIT
+3 IF '$DATA(^XTMP("AG7P2"))
SET ^XTMP("AG7P2",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"AG7P2 - SAVE OPTION CONFIGURATIONS."
+4 NEW I,A
+5 SET I=$ORDER(^DIC(19,"B",AGM,0))
+6 IF 'I
DO BMES^XPDUTL("NOT SAVED. Option '"_AGM_"' not found in OPTION file.")
QUIT
+7 SET A=0
+8 FOR
SET A=$ORDER(^DIC(19,I,10,A))
IF 'A
QUIT
SET ^XTMP("AG7P2",7.2,"OPTSAV",AGM,A)=$PIECE(^DIC(19,+^DIC(19,I,10,A,0),0),U,1)_U_$PIECE(^DIC(19,I,10,A,0),U,2,3)
+9 QUIT
+10 ;
INSTALLD(AGINSTAL) ;EP - Determine if patch AGINSTAL was installed, where AGINSTAL is
+1 ; the name of the INSTALL. E.g "AG*6.0*10".
+2 ;;^DIC(9.4,D0,22,D1,PAH,D2,0)=
+3 ;;(#.01) PATCH APPLICATION HISTORY [1F] ^ (#.02)DATE APPLIED [2D] ^ (#.03) APPLIED BY [3P] ^
+4 NEW DIC,X,Y
+5 SET X=$PIECE(AGINSTAL,"*",1)
+6 SET DIC="^DIC(9.4,"
SET DIC(0)="FM"
SET D="C"
+7 DO IX^DIC
+8 IF Y<1
QUIT 0
+9 SET DIC=DIC_+Y_",22,"
SET X=$PIECE(AGINSTAL,"*",2)
+10 DO ^DIC
+11 IF Y<1
QUIT 0
+12 SET DIC=DIC_+Y_",""PAH"","
SET X=$PIECE(AGINSTAL,"*",3)
+13 DO ^DIC
+14 QUIT $SELECT(Y<1:0,1:1)
+15 ;
LAST(PKG,VER) ;returns last patch applied for a Package, PATCH^DATE
+1 ; Patch includes Seq # if Released
+2 NEW PKGIEN,VERIEN,LATEST,PATCH,SUBIEN
+3 IF $GET(VER)=""
SET VER=$$VERSION^XPDUTL(PKG)
IF 'VER
QUIT -1
+4 SET PKGIEN=$ORDER(^DIC(9.4,"B",PKG,""))
IF 'PKGIEN
QUIT -1
+5 SET VERIEN=$ORDER(^DIC(9.4,PKGIEN,22,"B",VER,""))
IF 'VERIEN
QUIT -1
+6 SET LATEST=-1
SET PATCH=-1
SET SUBIEN=0
+7 FOR
SET SUBIEN=$ORDER(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN))
IF SUBIEN'>0
QUIT
Begin DoDot:1
+8 IF $PIECE(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST
SET LATEST=$PIECE(^(0),U,2)
SET PATCH=$PIECE(^(0),U)
End DoDot:1
+9 QUIT PATCH_U_LATEST
