BADEECP1 ;IHS/MSC/MGH - BADE ENVIRONMENT CHECK ROUTINE ;28-Jun-2010 16:21;MGH
;;1.0;DENTAL/EDR INTERFACE;**1**;AUG 22, 2011
;
ENV ;EP
N IN,PATCH,INSTDA,STAT
;Check for the installation of the EHR
S IN="IHS PCC SUITE 2.0",INSTDA=""
I '$D(^XPD(9.7,"B",IN)) D Q
.D MES("You must first install the IHS PCC SUITE 2.0 before this patch",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
.D MES("IHS PCC SUITE 2.0 must be completely installed before installing this patch",2)
S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
;Check for the installation of the EDR
S IN="DENTAL/EDR INTERFACE 1.0",INSTDA=""
I '$D(^XPD(9.7,"B",IN)) D Q
.D MES("You must first install the DENTAL/EDR INTERFACE 1.0 before this patch",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
.D MES("DENTAL/EDR INTERFACE 1.0 must be completely installed before installing this patch",2)
S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
Q
;
MES(TXT,QUIT) ;EP
D BMES^XPDUTL(" "_$G(TXT))
S:$G(QUIT) XPDABORT=QUIT
Q
;
PRE ;EP - Pre-init
Q
RENXPAR(OLD,NEW) ; Rename parameter
N IEN,FDA,FIL
S FIL=8989.51
Q:$$FIND1^DIC(FIL,"","X",NEW) ; New name already exists
S IEN=$$FIND1^DIC(FIL,"","X",OLD)
Q:'IEN ; Old name doesn't exist
S FDA(FIL,IEN_",",.01)=NEW
D FILE^DIE("E","FDA")
Q
POST ;EP
N XMRG
D EN^XPAR("SYS","BADE EDR PAUSE MRG LOAD",,"Y")
D EN^XPAR("SYS","BADE EDR MRG DFN",,"")
D EN^XPAR("SYS","BADE EDR MRG LOAD TSK",,"")
D EN^XPAR("SYS","BADE EDR MRG TOTAL",,0)
D EN^XPAR("SYS","BADE EDR MRG PTS ERRORS",,"")
D EN^XPAR("SYS","BADE EDR MRG ERRORS",,0)
;CLEAN OUT OUT OF ORDER MESSAGES
S MENU(1)="BADE EDR UPLOAD ALL MERGED PTS"
S MENU(2)="BADE EDR PAUSE MRG LOAD"
S MENU(3)="BADE EDR RESTART MRG UPLOAD"
F I=1:1:3 D
.N DA,DIE,DR
.S MSG=""
.S DA=$O(^DIC(19,"B",MENU(I),""))
.I DA'="" D
..S DIE="^DIC(19,",DR="2///@"
..D ^DIE
;
;Check and see if patient merge has been installed yet
S XMRG=$$VERSION^XPDUTL("BPM")
;Check and see if patient merge patch 1 has been installed yet
I 'XMRG D COMPLETE^BADEMRG("NO BPM") D BMES^XPDUTL(" Patient Merge not Installed") ;SAIC/FJE DISPALY RESULTS
D CKPATCH
D BMES^XPDUTL(" Post Initialization Completed") ;SAIC/FJE DISPLAY RESULTS
Q
; Register a protocol to an extended action protocol
; Input: P-Parent protocol
; C-Child protocol
; SEQ-Sequence Number
REGPROT(P,C,SEQ,ERR) ;EP
N IENARY,PIEN,AIEN,FDA
D
.I '$L(P)!('$L(C)) S ERR="Missing input parameter" Q
.S IENARY(1)=$$FIND1^DIC(101,"","",P)
.S AIEN=$$FIND1^DIC(101,"","",C)
.I 'IENARY(1)!'AIEN S ERR="Unknown protocol name" Q
.S FDA(101.01,"?+2,"_IENARY(1)_",",.01)=AIEN
.S FDA(101.01,"?+2,"_IENARY(1)_",",3)=SEQ
.D UPDATE^DIE("S","FDA","IENARY","ERR")
;Q:$Q $G(ERR)=""
Q
; Return IEN to Clinic Stop Code file for given stop code
GETSC(SC) ;EP
N RES
S RES=$$FIND1^DIC(40.7,,,SC,"C")
Q +RES
; Return first IEN to Hospital Location file for given stop code ien
GETHLOC(SIEN) ;EP
N RES
Q:'$G(SIEN) 0
S RES=$O(^SC("ASTOP",SIEN,0))
Q +RES
CKPATCH ;Only add protocol if BPM patch 1 is installed
S PATCH="BPM*1.0*1"
I $$PATCH^XPDUTL(PATCH) D REGPROT("BPM MERGE PATIENT ADT-A40","BADE MERGE PATIENT ADT-A40",967) D BMES^XPDUTL(" BADE Merge Protocol added") ;SAIC/FJE DISPALY RESULTS
I '$$PATCH^XPDUTL(PATCH) D BMES^XPDUTL(" BADE Merge Protocol Not Created") ;SAIC/FJE DISPALY RESULTS
Q
BADEECP1 ;IHS/MSC/MGH - BADE ENVIRONMENT CHECK ROUTINE ;28-Jun-2010 16:21;MGH
+1 ;;1.0;DENTAL/EDR INTERFACE;**1**;AUG 22, 2011
+2 ;
ENV ;EP
+1 NEW IN,PATCH,INSTDA,STAT
+2 ;Check for the installation of the EHR
+3 SET IN="IHS PCC SUITE 2.0"
SET INSTDA=""
+4 IF '$DATA(^XPD(9.7,"B",IN))
Begin DoDot:1
+5 DO MES("You must first install the IHS PCC SUITE 2.0 before this patch",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 DO MES("IHS PCC SUITE 2.0 must be completely installed before installing this patch",2)
End DoDot:1
QUIT
+10 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+11 ;Check for the installation of the EDR
+12 SET IN="DENTAL/EDR INTERFACE 1.0"
SET INSTDA=""
+13 IF '$DATA(^XPD(9.7,"B",IN))
Begin DoDot:1
+14 DO MES("You must first install the DENTAL/EDR INTERFACE 1.0 before this patch",2)
End DoDot:1
QUIT
+15 SET INSTDA=$ORDER(^XPD(9.7,"B",IN,INSTDA),-1)
+16 SET STAT=+$PIECE($GET(^XPD(9.7,INSTDA,0)),U,9)
+17 IF STAT'=3
Begin DoDot:1
+18 DO MES("DENTAL/EDR INTERFACE 1.0 must be completely installed before installing this patch",2)
End DoDot:1
QUIT
+19 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+20 QUIT
+21 ;
MES(TXT,QUIT) ;EP
+1 DO BMES^XPDUTL(" "_$GET(TXT))
+2 IF $GET(QUIT)
SET XPDABORT=QUIT
+3 QUIT
+4 ;
PRE ;EP - Pre-init
+1 QUIT
RENXPAR(OLD,NEW) ; Rename parameter
+1 NEW IEN,FDA,FIL
+2 SET FIL=8989.51
+3 ; New name already exists
IF $$FIND1^DIC(FIL,"","X",NEW)
QUIT
+4 SET IEN=$$FIND1^DIC(FIL,"","X",OLD)
+5 ; Old name doesn't exist
IF 'IEN
QUIT
+6 SET FDA(FIL,IEN_",",.01)=NEW
+7 DO FILE^DIE("E","FDA")
+8 QUIT
POST ;EP
+1 NEW XMRG
+2 DO EN^XPAR("SYS","BADE EDR PAUSE MRG LOAD",,"Y")
+3 DO EN^XPAR("SYS","BADE EDR MRG DFN",,"")
+4 DO EN^XPAR("SYS","BADE EDR MRG LOAD TSK",,"")
+5 DO EN^XPAR("SYS","BADE EDR MRG TOTAL",,0)
+6 DO EN^XPAR("SYS","BADE EDR MRG PTS ERRORS",,"")
+7 DO EN^XPAR("SYS","BADE EDR MRG ERRORS",,0)
+8 ;CLEAN OUT OUT OF ORDER MESSAGES
+9 SET MENU(1)="BADE EDR UPLOAD ALL MERGED PTS"
+10 SET MENU(2)="BADE EDR PAUSE MRG LOAD"
+11 SET MENU(3)="BADE EDR RESTART MRG UPLOAD"
+12 FOR I=1:1:3
Begin DoDot:1
+13 NEW DA,DIE,DR
+14 SET MSG=""
+15 SET DA=$ORDER(^DIC(19,"B",MENU(I),""))
+16 IF DA'=""
Begin DoDot:2
+17 SET DIE="^DIC(19,"
SET DR="2///@"
+18 DO ^DIE
End DoDot:2
End DoDot:1
+19 ;
+20 ;Check and see if patient merge has been installed yet
+21 SET XMRG=$$VERSION^XPDUTL("BPM")
+22 ;Check and see if patient merge patch 1 has been installed yet
+23 ;SAIC/FJE DISPALY RESULTS
IF 'XMRG
DO COMPLETE^BADEMRG("NO BPM")
DO BMES^XPDUTL(" Patient Merge not Installed")
+24 DO CKPATCH
+25 ;SAIC/FJE DISPLAY RESULTS
DO BMES^XPDUTL(" Post Initialization Completed")
+26 QUIT
+27 ; Register a protocol to an extended action protocol
+28 ; Input: P-Parent protocol
+29 ; C-Child protocol
+30 ; SEQ-Sequence Number
REGPROT(P,C,SEQ,ERR) ;EP
+1 NEW IENARY,PIEN,AIEN,FDA
+2 Begin DoDot:1
+3 IF '$LENGTH(P)!('$LENGTH(C))
SET ERR="Missing input parameter"
QUIT
+4 SET IENARY(1)=$$FIND1^DIC(101,"","",P)
+5 SET AIEN=$$FIND1^DIC(101,"","",C)
+6 IF 'IENARY(1)!'AIEN
SET ERR="Unknown protocol name"
QUIT
+7 SET FDA(101.01,"?+2,"_IENARY(1)_",",.01)=AIEN
+8 SET FDA(101.01,"?+2,"_IENARY(1)_",",3)=SEQ
+9 DO UPDATE^DIE("S","FDA","IENARY","ERR")
End DoDot:1
+10 ;Q:$Q $G(ERR)=""
+11 QUIT
+12 ; Return IEN to Clinic Stop Code file for given stop code
GETSC(SC) ;EP
+1 NEW RES
+2 SET RES=$$FIND1^DIC(40.7,,,SC,"C")
+3 QUIT +RES
+4 ; Return first IEN to Hospital Location file for given stop code ien
GETHLOC(SIEN) ;EP
+1 NEW RES
+2 IF '$GET(SIEN)
QUIT 0
+3 SET RES=$ORDER(^SC("ASTOP",SIEN,0))
+4 QUIT +RES
CKPATCH ;Only add protocol if BPM patch 1 is installed
+1 SET PATCH="BPM*1.0*1"
+2 ;SAIC/FJE DISPALY RESULTS
IF $$PATCH^XPDUTL(PATCH)
DO REGPROT("BPM MERGE PATIENT ADT-A40","BADE MERGE PATIENT ADT-A40",967)
DO BMES^XPDUTL(" BADE Merge Protocol added")
+3 ;SAIC/FJE DISPALY RESULTS
IF '$$PATCH^XPDUTL(PATCH)
DO BMES^XPDUTL(" BADE Merge Protocol Not Created")
+4 QUIT
