BJPC2P3 ; IHS/CMI/LAB - PCC Suite v1.0 patch 3 environment check ;
;;2.0;IHS PCC SUITE;**4**;MAY 14, 2009
;
;
; The following line prevents the "Disable Options..." and "Move Routines..." questions from being asked during the install.
I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
I '$$INSTALLD("APCL*3.0*25") D SORRY(2)
I '$$INSTALLD("BJPC*2.0*2") D SORRY(2)
;
Q
;
PRE ;
S BJPCDA=0 F S BJPCDA=$O(^APCLVSTS(BJPCDA)) Q:BJPCDA'=+BJPCDA S DA=BJPCDA,DIK="^APCLVSTS(" D ^DIK
K DIK,DA
S DA=$O(^APCHSCMP("B","MEASUREMENT PANELS",0))
I DA S DIE="^APCHSCMP(",DR=".01///MEASUREMENT PANELS (OUTPATIENT)" D ^DIE
S DA=$O(^APCHSCMP("B","MEASUREMENTS",0))
I DA S DIE="^APCHSCMP(",DR=".01///MEASUREMENTS (OUTPATIENT)" D ^DIE
K DA,DIE,DR
;DELETE V MEAS DD SO XREFS GO AWAY
S DIU(0)="",DIU=9000010.01
D EN^DIU2
Q
POST ;
;file qualifiers into multiple 1 in GMRV VITAL QUALIFIERS
D MES^XPDUTL("Adding Measurement Type to Vital Qualifiers file...")
;wipe out existing data
S X=0 F S X=$O(^GMRD(120.52,X)) Q:X'=+X K ^GMRD(120.52,X,1)
K ^GMRD(120.52,"AA"),^GMRD(120.52,"BB"),^GMRD(120.52,"D"),^GMRD(120.52,"C")
NEW BJPCVIEN,BJPCMT,BJPCCAT,BJPCMIEN,BJPCFDA,BJPCIENS,BJPCERRR,BJPCAIEN
S BJPCVIEN=0
F S BJPCVIEN=$O(@XPDGREF@("VITALQUALMT",BJPCVIEN)) Q:BJPCVIEN<1 D
.S BJPCMIEN=0 F S BJPCMIEN=$O(@XPDGREF@("VITALQUALMT",BJPCVIEN,BJPCMIEN)) Q:BJPCMIEN'=+BJPCMIEN D
..S MT=$P(@XPDGREF@("VITALQUALMT",BJPCVIEN,BJPCMIEN),U,1)
..S CAT=$P(@XPDGREF@("VITALQUALMT",BJPCVIEN,BJPCMIEN),U,2)
..;file entry into multiple using the external values
..K BJPCFDA,BJPCIENS,BJPCERRR,BJPCAIEN
..S BJPCIENS="+2,"_BJPCVIEN_","
..S BJPCFDA(120.521,BJPCIENS,.01)=MT
..S BJPCFDA(120.521,BJPCIENS,.02)=CAT
..D UPDATE^DIE("E","BJPCFDA","BJPCIENS","BJPCERRR(1)")
..I $D(BJPCERRR) D MES^XPDUTL("Error updating qualifier "_$P(^GMRD(120.52,BJPCVIEN,0),U)_" / measurement type "_MT)
VMEAS ;
D MES^XPDUTL("hold on...fixing V Measurement entries, this may take a while...")
;take 1201 field value and if entered by data entry move to .07 and then wipe out 1201 field
S BJPCDA=0,BJPCCNT=0 F S BJPCDA=$O(^AUPNVMSR(BJPCDA)) Q:BJPCDA'=+BJPCDA D
.S BJPCCNT=BJPCCNT+1
.I '(BJPCCNT#10000) W "."
.Q:'$D(^AUPNVMSR(BJPCDA,12))
.Q:'$P(^AUPNVMSR(BJPCDA,12),U,1) ;no date
.Q:$P(^AUPNVMSR(BJPCDA,12),U,2) ;EHR Entered
.Q:$P(^AUPNVMSR(BJPCDA,12),U,4) ;EHR ENTERED
.S BJPCSAVE=$P(^AUPNVMSR(BJPCDA,0),U,7)
.S DA=BJPCDA,DR=".07///"_$P(^AUPNVMSR(BJPCDA,12),U,1)_";1201///@",DIE="^AUPNVMSR(" D ^DIE K DA,DIE,DR
.I BJPCSAVE]"" S DA=BJPCDA,DR="1201///"_BJPCSAVE,DIE="^AUPNVMSR(" D ^DIE K DA,DR,DIE ;if they had entered a .07 move it to 1201 although I doubt d/e entered it as they don't know it
;reindex AB and AE if they are moved to 1201
D MES^XPDUTL("reindexing AB and AE xrefs...")
K ^AUPNVMSR("AB"),^AUPNVMSR("AE") ;kill existing xrefs
S DIK="^AUPNVMSR(",DIK(1)="1201^AB^AE"
D ENALL^DIK
Q
INSTALLD(BJPCSTAL) ;EP - Determine if patch BJPCSTAL was installed, where
; APCLSTAL is the name of the INSTALL. E.g "AG*6.0*11".
;
NEW BJPCY,DIC,X,Y
S X=$P(BJPCSTAL,"*",1)
S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
D IX^DIC
I Y<1 D IMES Q 0
S DIC=DIC_+Y_",22,",X=$P(BJPCSTAL,"*",2)
D ^DIC
I Y<1 D IMES Q 0
S DIC=DIC_+Y_",""PAH"",",X=$P(BJPCSTAL,"*",3)
D ^DIC
S BJPCY=Y
D IMES
Q $S(BJPCY<1:0,1:1)
IMES ;
D MES^XPDUTL($$CJ^XLFSTR("Patch """_BJPCSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
Q
SORRY(X) ;
KILL DIFQ
I X=3 S XPDQUIT=2 Q
S XPDQUIT=X
W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
Q
; Pre-Transport global for Vital Qualifier measurement type mapping (multiple)
PRETRAN ;
N IEN,VAL,TXT,MIEN,MT,CAT,BJPCAR,J,BJPCC
S IEN=0,BJPCC=0
F S IEN=$O(^GMRD(120.52,IEN)) Q:IEN<1 D
.K BJPCAR
.D GETS^DIQ(120.52,IEN_",",1_"*","","BJPCAR")
.S J="" F S J=$O(BJPCAR(120.521,J)) Q:J="" D
..S MT=$G(BJPCAR(120.521,J,.01))
..S CAT=$G(BJPCAR(120.521,J,.02))
..S BJPCC=BJPCC+1
..S @XPDGREF@("VITALQUALMT",IEN,BJPCC)=MT_"^"_CAT
Q
BJPC2P3 ; IHS/CMI/LAB - PCC Suite v1.0 patch 3 environment check ;
+1 ;;2.0;IHS PCC SUITE;**4**;MAY 14, 2009
+2 ;
+3 ;
+4 ; The following line prevents the "Disable Options..." and "Move Routines..." questions from being asked during the install.
+5 IF $GET(XPDENV)=1
SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+6 FOR X="XPO1","XPZ1","XPZ2","XPI1"
SET XPDDIQ(X)=0
+7 IF '$$INSTALLD("APCL*3.0*25")
DO SORRY(2)
+8 IF '$$INSTALLD("BJPC*2.0*2")
DO SORRY(2)
+9 ;
+10 QUIT
+11 ;
PRE ;
+1 SET BJPCDA=0
FOR
SET BJPCDA=$ORDER(^APCLVSTS(BJPCDA))
IF BJPCDA'=+BJPCDA
QUIT
SET DA=BJPCDA
SET DIK="^APCLVSTS("
DO ^DIK
+2 KILL DIK,DA
+3 SET DA=$ORDER(^APCHSCMP("B","MEASUREMENT PANELS",0))
+4 IF DA
SET DIE="^APCHSCMP("
SET DR=".01///MEASUREMENT PANELS (OUTPATIENT)"
DO ^DIE
+5 SET DA=$ORDER(^APCHSCMP("B","MEASUREMENTS",0))
+6 IF DA
SET DIE="^APCHSCMP("
SET DR=".01///MEASUREMENTS (OUTPATIENT)"
DO ^DIE
+7 KILL DA,DIE,DR
+8 ;DELETE V MEAS DD SO XREFS GO AWAY
+9 SET DIU(0)=""
SET DIU=9000010.01
+10 DO EN^DIU2
+11 QUIT
POST ;
+1 ;file qualifiers into multiple 1 in GMRV VITAL QUALIFIERS
+2 DO MES^XPDUTL("Adding Measurement Type to Vital Qualifiers file...")
+3 ;wipe out existing data
+4 SET X=0
FOR
SET X=$ORDER(^GMRD(120.52,X))
IF X'=+X
QUIT
KILL ^GMRD(120.52,X,1)
+5 KILL ^GMRD(120.52,"AA"),^GMRD(120.52,"BB"),^GMRD(120.52,"D"),^GMRD(120.52,"C")
+6 NEW BJPCVIEN,BJPCMT,BJPCCAT,BJPCMIEN,BJPCFDA,BJPCIENS,BJPCERRR,BJPCAIEN
+7 SET BJPCVIEN=0
+8 FOR
SET BJPCVIEN=$ORDER(@XPDGREF@("VITALQUALMT",BJPCVIEN))
IF BJPCVIEN<1
QUIT
Begin DoDot:1
+9 SET BJPCMIEN=0
FOR
SET BJPCMIEN=$ORDER(@XPDGREF@("VITALQUALMT",BJPCVIEN,BJPCMIEN))
IF BJPCMIEN'=+BJPCMIEN
QUIT
Begin DoDot:2
+10 SET MT=$PIECE(@XPDGREF@("VITALQUALMT",BJPCVIEN,BJPCMIEN),U,1)
+11 SET CAT=$PIECE(@XPDGREF@("VITALQUALMT",BJPCVIEN,BJPCMIEN),U,2)
+12 ;file entry into multiple using the external values
+13 KILL BJPCFDA,BJPCIENS,BJPCERRR,BJPCAIEN
+14 SET BJPCIENS="+2,"_BJPCVIEN_","
+15 SET BJPCFDA(120.521,BJPCIENS,.01)=MT
+16 SET BJPCFDA(120.521,BJPCIENS,.02)=CAT
+17 DO UPDATE^DIE("E","BJPCFDA","BJPCIENS","BJPCERRR(1)")
+18 IF $DATA(BJPCERRR)
DO MES^XPDUTL("Error updating qualifier "_$PIECE(^GMRD(120.52,BJPCVIEN,0),U)_" / measurement type "_MT)
End DoDot:2
End DoDot:1
VMEAS ;
+1 DO MES^XPDUTL("hold on...fixing V Measurement entries, this may take a while...")
+2 ;take 1201 field value and if entered by data entry move to .07 and then wipe out 1201 field
+3 SET BJPCDA=0
SET BJPCCNT=0
FOR
SET BJPCDA=$ORDER(^AUPNVMSR(BJPCDA))
IF BJPCDA'=+BJPCDA
QUIT
Begin DoDot:1
+4 SET BJPCCNT=BJPCCNT+1
+5 IF '(BJPCCNT#10000)
WRITE "."
+6 IF '$DATA(^AUPNVMSR(BJPCDA,12))
QUIT
+7 ;no date
IF '$PIECE(^AUPNVMSR(BJPCDA,12),U,1)
QUIT
+8 ;EHR Entered
IF $PIECE(^AUPNVMSR(BJPCDA,12),U,2)
QUIT
+9 ;EHR ENTERED
IF $PIECE(^AUPNVMSR(BJPCDA,12),U,4)
QUIT
+10 SET BJPCSAVE=$PIECE(^AUPNVMSR(BJPCDA,0),U,7)
+11 SET DA=BJPCDA
SET DR=".07///"_$PIECE(^AUPNVMSR(BJPCDA,12),U,1)_";1201///@"
SET DIE="^AUPNVMSR("
DO ^DIE
KILL DA,DIE,DR
+12 ;if they had entered a .07 move it to 1201 although I doubt d/e entered it as they don't know it
IF BJPCSAVE]""
SET DA=BJPCDA
SET DR="1201///"_BJPCSAVE
SET DIE="^AUPNVMSR("
DO ^DIE
KILL DA,DR,DIE
End DoDot:1
+13 ;reindex AB and AE if they are moved to 1201
+14 DO MES^XPDUTL("reindexing AB and AE xrefs...")
+15 ;kill existing xrefs
KILL ^AUPNVMSR("AB"),^AUPNVMSR("AE")
+16 SET DIK="^AUPNVMSR("
SET DIK(1)="1201^AB^AE"
+17 DO ENALL^DIK
+18 QUIT
INSTALLD(BJPCSTAL) ;EP - Determine if patch BJPCSTAL was installed, where
+1 ; APCLSTAL is the name of the INSTALL. E.g "AG*6.0*11".
+2 ;
+3 NEW BJPCY,DIC,X,Y
+4 SET X=$PIECE(BJPCSTAL,"*",1)
+5 SET DIC="^DIC(9.4,"
SET DIC(0)="FM"
SET D="C"
+6 DO IX^DIC
+7 IF Y<1
DO IMES
QUIT 0
+8 SET DIC=DIC_+Y_",22,"
SET X=$PIECE(BJPCSTAL,"*",2)
+9 DO ^DIC
+10 IF Y<1
DO IMES
QUIT 0
+11 SET DIC=DIC_+Y_",""PAH"","
SET X=$PIECE(BJPCSTAL,"*",3)
+12 DO ^DIC
+13 SET BJPCY=Y
+14 DO IMES
+15 QUIT $SELECT(BJPCY<1:0,1:1)
IMES ;
+1 DO MES^XPDUTL($$CJ^XLFSTR("Patch """_BJPCSTAL_""" is"_$SELECT(Y<1:" *NOT*",1:"")_" installed.",IOM))
+2 QUIT
SORRY(X) ;
+1 KILL DIFQ
+2 IF X=3
SET XPDQUIT=2
QUIT
+3 SET XPDQUIT=X
+4 WRITE *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
+5 QUIT
+6 ; Pre-Transport global for Vital Qualifier measurement type mapping (multiple)
PRETRAN ;
+1 NEW IEN,VAL,TXT,MIEN,MT,CAT,BJPCAR,J,BJPCC
+2 SET IEN=0
SET BJPCC=0
+3 FOR
SET IEN=$ORDER(^GMRD(120.52,IEN))
IF IEN<1
QUIT
Begin DoDot:1
+4 KILL BJPCAR
+5 DO GETS^DIQ(120.52,IEN_",",1_"*","","BJPCAR")
+6 SET J=""
FOR
SET J=$ORDER(BJPCAR(120.521,J))
IF J=""
QUIT
Begin DoDot:2
+7 SET MT=$GET(BJPCAR(120.521,J,.01))
+8 SET CAT=$GET(BJPCAR(120.521,J,.02))
+9 SET BJPCC=BJPCC+1
+10 SET @XPDGREF@("VITALQUALMT",IEN,BJPCC)=MT_"^"_CAT
End DoDot:2
End DoDot:1
+11 QUIT
