BJPC2P20 ; IHS/CMI/LAB - PCC Suite v2.0 P15 ; 31 Jan 2017 11:18 AM
;;2.0;IHS PCC SUITE;**20**;MAY 14, 2009;Build 25
;
;
; 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
;KERNEL
I +$$VERSION^XPDUTL("XU")<8 D MES^XPDUTL($$CJ^XLFSTR("Version 8.0 of KERNEL is required. Not installed",80)) D SORRY(2) I 1
E D MES^XPDUTL($$CJ^XLFSTR("Requires Kernel Version 8.0....Present.",80))
;FILEMAN
I +$$VERSION^XPDUTL("DI")<22 D MES^XPDUTL($$CJ^XLFSTR("Version 22.0 of FILEMAN is required. Not installed.",80)) D SORRY(2) I 1
E D MES^XPDUTL($$CJ^XLFSTR("Requires Fileman v22....Present.",80))
I '$$INSTALLD("BJPC*2.0*19") D MES^XPDUTL($$CJ^XLFSTR("Requires bjpc V2.0 patch 19. Not installed.",80)) D SORRY(2)
Q
;
PRE ;
S DIU=9000010.16,DIU(0)="" D EN^DIU2 K DIU
Q
POST ;
D ADDMSR ;add measurement to PCC MAN REPORTS VGEN MEASUREMENT TYPE
S X=$$ADD^XPDMENU("APCDSUPER","APCD DELETE DUPE PT ED","DDPE",35)
I 'X W !,"Attempt to add DUPLICATE PATIENT ED option failed.." H 3
;
S DA=$O(^APCLACTG("B","PHN",0)) I DA S DIE="^APCLACTG(",DR=".04///1" D ^DIE K DA,DIE,DR
;FIX MEAS PANEL VU OR VC, TRANSFORM AND LENGTH
NEW BJPCDA,BJPCDA1,X,M
S BJPCDA=0 F S BJPCDA=$O(^APCHSMPN(BJPCDA)) Q:BJPCDA'=+BJPCDA D
.S BJPCDA1=0 F S BJPCDA1=$O(^APCHSMPN(BJPCDA,1,BJPCDA1)) Q:BJPCDA1'=+BJPCDA1 D
..S X=$P($G(^APCHSMPN(BJPCDA,1,BJPCDA1,0)),U,2)
..Q:'X
..S M=$P($G(^AUTTMSR(X,0)),U,1)
..I M'="VU",M'="VC" Q ;VISION ONLY
..S $P(^APCHSMPN(BJPCDA,1,BJPCDA1,0),U,3)=17
..S ^APCHSMPN(BJPCDA,1,BJPCDA1,1)="S X=$$VCVU^AUPNVMSR(X,APCHSVNM)"
;
ER ;MOVE V ER .16 TO 1.01
D MES^XPDUTL($$CJ^XLFSTR("Moving .16 of V ER to 1.01",80))
S BJPCDA=0 F S BJPCDA=$O(^AUPNVER(BJPCDA)) Q:BJPCDA'=+BJPCDA D
.S BJPCX=$$VAL^XBDIQ1(9000010.29,BJPCDA,.16)
.Q:BJPCX=""
.S DIE="^AUPNVER(",DA=BJPCDA,DR="1.01///"_BJPCX D ^DIE K DA,DIE,DR
.Q
VPED ;REINDEX APRB, APRV ON V PATIENT ED
D MES^XPDUTL($$CJ^XLFSTR("Reindexing APRB and APRV on V Patient ED",80))
K ^AUPNVPED("APRB")
K ^AUPNVPED("APRV")
S DIK="^AUPNVPED(",DIK(1)="1103^APRB^APRV" D ENALL^DIK K DIK
Q
ADDMSR ;-add the measurement type
N I
F I="BMI","BMIP" D ADDM(I)
Q
;
ADDM(MSR) ;-- add it here
N FDA,FIENS,FERR,MSRI,MIEN
N WFIENS,WFERR,WFROOT,WP
S MSRI=$O(^AUTTMSR("B",MSR,0))
Q:'MSRI
Q:$O(^APCLVGMS("B",MSRI,0))
S FIENS="+1,"
S FDA(9001003.71,FIENS,.01)=MSRI
S FDA(9001003.71,FIENS,.02)=1
D UPDATE^DIE("","FDA","FIENS","FERR(1)")
I $D(FERR(1)) Q
S MIEN=$G(FIENS(1))
S ^APCLVGMS(MIEN,2)="K:X'[""-"" X I $D(X) D NUMIP^APCLVL03"
S WFIENS=MIEN_","
I MSR="BMI" D BMIH
I MSR="BMIP" D BMIPH
D WP^DIE(9001003.71,WFIENS,1,,"BJPCH")
K BJPCH
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
;
BMIH ;-bmi help
K BJPCH
S BJPCH(1)="Enter a range of BMI values to search for. Enter the range in the "
S BJPCH(2)="format nnn-nnn. For example, to search for all BMI measurements with "
S BJPCH(3)="a value of 20-30 enter 20-30."
Q
;
BMIPH ;-bmip help
K BJPCH
S BJPCH(1)="Enter a range of BMIP values to search for. Enter the range in the "
S BJPCH(2)="format nnn-nnn (decimal digits are allowed)."
S BJPCH(3)=" For example, to search for all BMIP measurements with"
S BJPCH(4)="a value of 50-60 enter 50-60."
Q
;
BJPC2P20 ; IHS/CMI/LAB - PCC Suite v2.0 P15 ; 31 Jan 2017 11:18 AM
+1 ;;2.0;IHS PCC SUITE;**20**;MAY 14, 2009;Build 25
+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 ;KERNEL
+8 IF +$$VERSION^XPDUTL("XU")<8
DO MES^XPDUTL($$CJ^XLFSTR("Version 8.0 of KERNEL is required. Not installed",80))
DO SORRY(2)
IF 1
+9 IF '$TEST
DO MES^XPDUTL($$CJ^XLFSTR("Requires Kernel Version 8.0....Present.",80))
+10 ;FILEMAN
+11 IF +$$VERSION^XPDUTL("DI")<22
DO MES^XPDUTL($$CJ^XLFSTR("Version 22.0 of FILEMAN is required. Not installed.",80))
DO SORRY(2)
IF 1
+12 IF '$TEST
DO MES^XPDUTL($$CJ^XLFSTR("Requires Fileman v22....Present.",80))
+13 IF '$$INSTALLD("BJPC*2.0*19")
DO MES^XPDUTL($$CJ^XLFSTR("Requires bjpc V2.0 patch 19. Not installed.",80))
DO SORRY(2)
+14 QUIT
+15 ;
PRE ;
+1 SET DIU=9000010.16
SET DIU(0)=""
DO EN^DIU2
KILL DIU
+2 QUIT
POST ;
+1 ;add measurement to PCC MAN REPORTS VGEN MEASUREMENT TYPE
DO ADDMSR
+2 SET X=$$ADD^XPDMENU("APCDSUPER","APCD DELETE DUPE PT ED","DDPE",35)
+3 IF 'X
WRITE !,"Attempt to add DUPLICATE PATIENT ED option failed.."
HANG 3
+4 ;
+5 SET DA=$ORDER(^APCLACTG("B","PHN",0))
IF DA
SET DIE="^APCLACTG("
SET DR=".04///1"
DO ^DIE
KILL DA,DIE,DR
+6 ;FIX MEAS PANEL VU OR VC, TRANSFORM AND LENGTH
+7 NEW BJPCDA,BJPCDA1,X,M
+8 SET BJPCDA=0
FOR
SET BJPCDA=$ORDER(^APCHSMPN(BJPCDA))
IF BJPCDA'=+BJPCDA
QUIT
Begin DoDot:1
+9 SET BJPCDA1=0
FOR
SET BJPCDA1=$ORDER(^APCHSMPN(BJPCDA,1,BJPCDA1))
IF BJPCDA1'=+BJPCDA1
QUIT
Begin DoDot:2
+10 SET X=$PIECE($GET(^APCHSMPN(BJPCDA,1,BJPCDA1,0)),U,2)
+11 IF 'X
QUIT
+12 SET M=$PIECE($GET(^AUTTMSR(X,0)),U,1)
+13 ;VISION ONLY
IF M'="VU"
IF M'="VC"
QUIT
+14 SET $PIECE(^APCHSMPN(BJPCDA,1,BJPCDA1,0),U,3)=17
+15 SET ^APCHSMPN(BJPCDA,1,BJPCDA1,1)="S X=$$VCVU^AUPNVMSR(X,APCHSVNM)"
End DoDot:2
End DoDot:1
+16 ;
ER ;MOVE V ER .16 TO 1.01
+1 DO MES^XPDUTL($$CJ^XLFSTR("Moving .16 of V ER to 1.01",80))
+2 SET BJPCDA=0
FOR
SET BJPCDA=$ORDER(^AUPNVER(BJPCDA))
IF BJPCDA'=+BJPCDA
QUIT
Begin DoDot:1
+3 SET BJPCX=$$VAL^XBDIQ1(9000010.29,BJPCDA,.16)
+4 IF BJPCX=""
QUIT
+5 SET DIE="^AUPNVER("
SET DA=BJPCDA
SET DR="1.01///"_BJPCX
DO ^DIE
KILL DA,DIE,DR
+6 QUIT
End DoDot:1
VPED ;REINDEX APRB, APRV ON V PATIENT ED
+1 DO MES^XPDUTL($$CJ^XLFSTR("Reindexing APRB and APRV on V Patient ED",80))
+2 KILL ^AUPNVPED("APRB")
+3 KILL ^AUPNVPED("APRV")
+4 SET DIK="^AUPNVPED("
SET DIK(1)="1103^APRB^APRV"
DO ENALL^DIK
KILL DIK
+5 QUIT
ADDMSR ;-add the measurement type
+1 NEW I
+2 FOR I="BMI","BMIP"
DO ADDM(I)
+3 QUIT
+4 ;
ADDM(MSR) ;-- add it here
+1 NEW FDA,FIENS,FERR,MSRI,MIEN
+2 NEW WFIENS,WFERR,WFROOT,WP
+3 SET MSRI=$ORDER(^AUTTMSR("B",MSR,0))
+4 IF 'MSRI
QUIT
+5 IF $ORDER(^APCLVGMS("B",MSRI,0))
QUIT
+6 SET FIENS="+1,"
+7 SET FDA(9001003.71,FIENS,.01)=MSRI
+8 SET FDA(9001003.71,FIENS,.02)=1
+9 DO UPDATE^DIE("","FDA","FIENS","FERR(1)")
+10 IF $DATA(FERR(1))
QUIT
+11 SET MIEN=$GET(FIENS(1))
+12 SET ^APCLVGMS(MIEN,2)="K:X'[""-"" X I $D(X) D NUMIP^APCLVL03"
+13 SET WFIENS=MIEN_","
+14 IF MSR="BMI"
DO BMIH
+15 IF MSR="BMIP"
DO BMIPH
+16 DO WP^DIE(9001003.71,WFIENS,1,,"BJPCH")
+17 KILL BJPCH
+18 QUIT
+19 ;
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 ;
BMIH ;-bmi help
+1 KILL BJPCH
+2 SET BJPCH(1)="Enter a range of BMI values to search for. Enter the range in the "
+3 SET BJPCH(2)="format nnn-nnn. For example, to search for all BMI measurements with "
+4 SET BJPCH(3)="a value of 20-30 enter 20-30."
+5 QUIT
+6 ;
BMIPH ;-bmip help
+1 KILL BJPCH
+2 SET BJPCH(1)="Enter a range of BMIP values to search for. Enter the range in the "
+3 SET BJPCH(2)="format nnn-nnn (decimal digits are allowed)."
+4 SET BJPCH(3)=" For example, to search for all BMIP measurements with"
+5 SET BJPCH(4)="a value of 50-60 enter 50-60."
+6 QUIT
+7 ;
