BPXRM203 ; IHS/MSC/MGH - Version 2.0 Patch 3. ;20-Nov-2014 15:19;du
;;2.0;CLINICAL REMINDERS;**1003**;Feb 04, 2005;Build 21
;
ENV ;EP environment check
N IN,INSTDA,STAT
;Check for the installation of Reminders 2.0
S IN="CLINICAL REMINDERS 2.0",INSTDA=""
I '$D(^XPD(9.7,"B",IN)) D Q
.W !,"You must first install CLINICAL REMINDERS 2.0 before this patch" S XPDQUIT=2
S INSTDA=$O(^XPD(9.7,"B",IN,INSTDA),-1)
S STAT=+$P($G(^XPD(9.7,INSTDA,0)),U,9)
I STAT'=3 D Q
.W !,"CLINICAL REMINDERS 2.0 must be completely installed before installing this patch." S XPDQUIT=2
S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
;Check for the installation of other patches
S PATCH="PXRM*2.0*1002"
I '$$PATCH(PATCH) D Q
. W !,"You must first install "_PATCH_"." S XPDQUIT=2
S IN="IHS STANDARD TERMINOLOGY 1.0",INSTDA=""
I '$D(^XPD(9.7,"B",IN)) D Q
.W !,"You must first install IHS STANDARD TERMINOLOGY 1.0 before this patch" S XPDQUIT=2
S INSTDA=$O(^XPD(9.7,"B",IN,INSTDA),-1)
S STAT=+$P($G(^XPD(9.7,INSTDA,0)),U,9)
I STAT'=3 D Q
.W !,"IHS STANDARD TERMINOLOGY 1.0 must be completely installed before installing this patch." S XPDQUIT=2
S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
S IN="IHS CLINICAL REPORTING 14.0",INSTDA=""
I '$D(^XPD(9.7,"B",IN)) D Q
.W !,"You must first install IHS CLINICAL REPORTING 14.0 before this patch" S XPDQUIT=2
S INSTDA=$O(^XPD(9.7,"B",IN,INSTDA),-1)
S STAT=+$P($G(^XPD(9.7,INSTDA,0)),U,9)
I STAT'=3 D Q
.W !,"IHS CLINICAL REPORTING 14.0 must be completely installed before installing this patch." S XPDQUIT=2
S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
Q
PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnnn
;copy of code from XPDUTL but modified to handle 4 digit IHS patch numb
Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N 0
NEW NUM,I,J
S I=$O(^DIC(9.4,"C",$P(X,"*"),0)) Q:'I 0
S J=$O(^DIC(9.4,I,22,"B",$P(X,"*",2),0)),X=$P(X,"*",3) Q:'J 0
;check if patch is just a number
Q:$O(^DIC(9.4,I,22,J,"PAH","B",X,0)) 1
S NUM=$O(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
Q (X=+NUM)
;===============================================================
PRE ;EP pre-init
Q
;===============================================================
POST ;Post-install
D CNAK
D RTAXEXP
Q
;================================================================
CNAK ;Make sure all "NAK" characters are converted back to "^" in
;the Exchange File.
N IEN,TEXT
D BMES^XPDUTL("Clean up Exchange File entries")
S IEN=0
F S IEN=+$O(^PXD(811.8,IEN)) Q:IEN=0 D
. D POSTKIDS^PXRMEXU5(IEN)
Q
;
;===============================================================
DELEI ;If the Exchange File entry already exists delete it.
N ARRAY,IC,IND,LIST,LUVALUE,NUM
S IC=0
F S IC=$O(ARRAY(IC)) Q:'IC D
.S LUVALUE(1)=ARRAY(IC,1)
.D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
.I '$D(LIST) Q
.S NUM=$P(LIST("DILIST",0),U,1)
.I NUM'=0 D
..F IND=1:1:NUM D
... N DA,DIK
... S DIK="^PXD(811.8,"
... S DA=LIST("DILIST",2,IND)
... D ^DIK
Q
;
RTAXEXP ;Rebuild taxonomy expansions.
N IEN,IND,TEXT,TNAME
S TNAME(1)="IHS-BARIUM ENEMA"
S TNAME(2)="IHS-COLONOSCOPY 2007"
S TNAME(3)="IHS-DEPO PROVERA ADMIN-2013"
S TNAME(4)="IHS DEPOPROVERA CODES"
S TNAME(5)="IHS-FECAL OCCULT LAB TEST"
S TNAME(6)="IHS-FUNDOSCOPIC EYE CODES 2007"
S TNAME(7)="IHS-HIGH RISK HPV TEST"
S TNAME(8)="IHS-HYSTERECTOMY 2009"
S TNAME(9)="IHS-MAMMOGRAM 2009"
S TNAME(10)="IHS-PAP CODES 2008"
S TNAME(11)="IHS-SIGMOIDOSCOPY"
S TNAME(12)="IHS-BILATERAL MASTECTOMY 2008"
D BMES^XPDUTL("Rebuilding taxonomy expansions.")
F IND=1:1:12 D
. S IEN=$O(^PXD(811.2,"B",TNAME(IND),""))
. I IEN="" Q
. S TEXT=" Working on taxonomy "_IEN
. D BMES^XPDUTL(TEXT)
. D DELEXTL^PXRMBXTL(IEN)
. D EXPAND^PXRMBXTL(IEN,"")
Q
BPXRM203 ; IHS/MSC/MGH - Version 2.0 Patch 3. ;20-Nov-2014 15:19;du
+1 ;;2.0;CLINICAL REMINDERS;**1003**;Feb 04, 2005;Build 21
+2 ;
ENV ;EP environment check
+1 NEW IN,INSTDA,STAT
+2 ;Check for the installation of Reminders 2.0
+3 SET IN="CLINICAL REMINDERS 2.0"
SET INSTDA=""
+4 IF '$DATA(^XPD(9.7,"B",IN))
Begin DoDot:1
+5 WRITE !,"You must first install CLINICAL REMINDERS 2.0 before this patch"
SET XPDQUIT=2
End DoDot:1
QUIT
+6 SET INSTDA=$ORDER(^XPD(9.7,"B",IN,INSTDA),-1)
+7 SET STAT=+$PIECE($GET(^XPD(9.7,INSTDA,0)),U,9)
+8 IF STAT'=3
Begin DoDot:1
+9 WRITE !,"CLINICAL REMINDERS 2.0 must be completely installed before installing this patch."
SET XPDQUIT=2
End DoDot:1
QUIT
+10 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+11 ;Check for the installation of other patches
+12 SET PATCH="PXRM*2.0*1002"
+13 IF '$$PATCH(PATCH)
Begin DoDot:1
+14 WRITE !,"You must first install "_PATCH_"."
SET XPDQUIT=2
End DoDot:1
QUIT
+15 SET IN="IHS STANDARD TERMINOLOGY 1.0"
SET INSTDA=""
+16 IF '$DATA(^XPD(9.7,"B",IN))
Begin DoDot:1
+17 WRITE !,"You must first install IHS STANDARD TERMINOLOGY 1.0 before this patch"
SET XPDQUIT=2
End DoDot:1
QUIT
+18 SET INSTDA=$ORDER(^XPD(9.7,"B",IN,INSTDA),-1)
+19 SET STAT=+$PIECE($GET(^XPD(9.7,INSTDA,0)),U,9)
+20 IF STAT'=3
Begin DoDot:1
+21 WRITE !,"IHS STANDARD TERMINOLOGY 1.0 must be completely installed before installing this patch."
SET XPDQUIT=2
End DoDot:1
QUIT
+22 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+23 SET IN="IHS CLINICAL REPORTING 14.0"
SET INSTDA=""
+24 IF '$DATA(^XPD(9.7,"B",IN))
Begin DoDot:1
+25 WRITE !,"You must first install IHS CLINICAL REPORTING 14.0 before this patch"
SET XPDQUIT=2
End DoDot:1
QUIT
+26 SET INSTDA=$ORDER(^XPD(9.7,"B",IN,INSTDA),-1)
+27 SET STAT=+$PIECE($GET(^XPD(9.7,INSTDA,0)),U,9)
+28 IF STAT'=3
Begin DoDot:1
+29 WRITE !,"IHS CLINICAL REPORTING 14.0 must be completely installed before installing this patch."
SET XPDQUIT=2
End DoDot:1
QUIT
+30 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+31 QUIT
PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnnn
+1 ;copy of code from XPDUTL but modified to handle 4 digit IHS patch numb
+2 IF X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N
QUIT 0
+3 NEW NUM,I,J
+4 SET I=$ORDER(^DIC(9.4,"C",$PIECE(X,"*"),0))
IF 'I
QUIT 0
+5 SET J=$ORDER(^DIC(9.4,I,22,"B",$PIECE(X,"*",2),0))
SET X=$PIECE(X,"*",3)
IF 'J
QUIT 0
+6 ;check if patch is just a number
+7 IF $ORDER(^DIC(9.4,I,22,J,"PAH","B",X,0))
QUIT 1
+8 SET NUM=$ORDER(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
+9 QUIT (X=+NUM)
+10 ;===============================================================
PRE ;EP pre-init
+1 QUIT
+2 ;===============================================================
POST ;Post-install
+1 DO CNAK
+2 DO RTAXEXP
+3 QUIT
+4 ;================================================================
CNAK ;Make sure all "NAK" characters are converted back to "^" in
+1 ;the Exchange File.
+2 NEW IEN,TEXT
+3 DO BMES^XPDUTL("Clean up Exchange File entries")
+4 SET IEN=0
+5 FOR
SET IEN=+$ORDER(^PXD(811.8,IEN))
IF IEN=0
QUIT
Begin DoDot:1
+6 DO POSTKIDS^PXRMEXU5(IEN)
End DoDot:1
+7 QUIT
+8 ;
+9 ;===============================================================
DELEI ;If the Exchange File entry already exists delete it.
+1 NEW ARRAY,IC,IND,LIST,LUVALUE,NUM
+2 SET IC=0
+3 FOR
SET IC=$ORDER(ARRAY(IC))
IF 'IC
QUIT
Begin DoDot:1
+4 SET LUVALUE(1)=ARRAY(IC,1)
+5 DO FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
+6 IF '$DATA(LIST)
QUIT
+7 SET NUM=$PIECE(LIST("DILIST",0),U,1)
+8 IF NUM'=0
Begin DoDot:2
+9 FOR IND=1:1:NUM
Begin DoDot:3
+10 NEW DA,DIK
+11 SET DIK="^PXD(811.8,"
+12 SET DA=LIST("DILIST",2,IND)
+13 DO ^DIK
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
RTAXEXP ;Rebuild taxonomy expansions.
+1 NEW IEN,IND,TEXT,TNAME
+2 SET TNAME(1)="IHS-BARIUM ENEMA"
+3 SET TNAME(2)="IHS-COLONOSCOPY 2007"
+4 SET TNAME(3)="IHS-DEPO PROVERA ADMIN-2013"
+5 SET TNAME(4)="IHS DEPOPROVERA CODES"
+6 SET TNAME(5)="IHS-FECAL OCCULT LAB TEST"
+7 SET TNAME(6)="IHS-FUNDOSCOPIC EYE CODES 2007"
+8 SET TNAME(7)="IHS-HIGH RISK HPV TEST"
+9 SET TNAME(8)="IHS-HYSTERECTOMY 2009"
+10 SET TNAME(9)="IHS-MAMMOGRAM 2009"
+11 SET TNAME(10)="IHS-PAP CODES 2008"
+12 SET TNAME(11)="IHS-SIGMOIDOSCOPY"
+13 SET TNAME(12)="IHS-BILATERAL MASTECTOMY 2008"
+14 DO BMES^XPDUTL("Rebuilding taxonomy expansions.")
+15 FOR IND=1:1:12
Begin DoDot:1
+16 SET IEN=$ORDER(^PXD(811.2,"B",TNAME(IND),""))
+17 IF IEN=""
QUIT
+18 SET TEXT=" Working on taxonomy "_IEN
+19 DO BMES^XPDUTL(TEXT)
+20 DO DELEXTL^PXRMBXTL(IEN)
+21 DO EXPAND^PXRMBXTL(IEN,"")
End DoDot:1
+22 QUIT
