BADEEVNT ;IHS/MSC/MGH - Dentrix HL7 interface ;30-Jun-2009 15:26;PLS
;;1.0;DENTAL/EDR INTERFACE;**1**;AUG 22, 2011
;; Modified - IHS/MSC/AMF - 11/23/10 - Updated Out of Order, alerts, removed H 2
;; Modified - IHS/MSC/VAC 9/2010 check for patient # in AUPNPAT
Q
TLOADPT ;EP Taskman call to start patient load
N STOP,ZTDTH,ZTIO,ZTDESC,ZTRTN,ZTSAVE,ZTPRI,ZTSK
;Make sure its not already running
S STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")
;Its already running and shouldn't be restarted
I STOP="NO" D H 3 Q
.W !,"Process is already running",!
I $$GET^XPAR("ALL","BADE EDR LAST DFN") D H 3 Q
.W !,"Upload process has already begun. Please use Restart option.",!
S ZTIO=""
S ZTPRI=1
S ZTDESC="Load Patient Data to EDR"
S ZTRTN="LOADPT^BADEEVNT"
S ZTSAVE("DUZ")=""
D ^%ZTLOAD
I $G(ZTSK) D
.D EN^XPAR("SYS","BADE EDR LOAD TSK",1,ZTSK)
.W !,"Task number "_ZTSK H 2
Q
LOADPT ;EP Load all patient's data
N DFN,CNT,CNTCHK,DATA,TOTAL,STOP,THROTTLE,BADELOAD
;Make sure the stop parameter is NO
D EN^XPAR("SYS","BADE EDR PAUSE PATIENT LOAD",1,"NO")
;Make sure the Pt DFN is set to null
S DFN=$$GET^XPAR("ALL","BADE EDR LAST DFN")
;Check to see how many patients to process before throttling
S CNTCHK=$$GET^XPAR("ALL","BADE EDR THROTTLE CT")
;Loop through the patients and send data
LOOP S DFN=$S(DFN>0:DFN,1:0),CNT=0,STOP="NO",TOTAL=0
F S DFN=$O(^DPT(DFN)) Q:+DFN'>0!(STOP="YES") D
.K PATNO
.S PATNO=$P($G(^AUPNPAT(DFN,0)),"^",1) ; IHS/MSC/VAC 9/2010 make sure patient # exists
.Q:PATNO'=DFN
.S PATNO=$D(^AUPNPAT(DFN,41))
.Q:PATNO=""
.S CNT=CNT+1
.S BADELOAD=1
.D A28^BADEEVNT(DFN)
.K BADELOAD
.;Set IEN into the DFN parameter
.D EN^XPAR("SYS","BADE EDR LAST DFN",1,"`"_DFN)
.;Add to total count
.S TOTAL=TOTAL+1
.D EN^XPAR("SYS","BADE EDR TOTAL PROCESSED",1,TOTAL)
.;Check to see if we should stop
.S STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")
.Q:STOP="YES"
.;If count=check throttle parameter
.I CNT=CNTCHK D
..S THROTTLE=$$GET^XPAR("ALL","BADE EDR PT THROTTLE")
..S CNTCHK=$$GET^XPAR("ALL","BADE EDR THROTTLE CT")
..I THROTTLE>0 H THROTTLE
..S CNT=0
;Finish up by resetting the pt parameter to null and the stop paramater to YES
I STOP="NO" D
.D EN^XPAR("SYS","BADE EDR PAUSE PATIENT LOAD",1,"YES")
.D EN^XPAR("SYS","BADE EDR LOAD TSK",1,"Upload complete")
.D COMPLETE
Q
TRESTRT ;EP Taskman call to restart patient load
N STOP,ZTDTH,ZTIO,ZTDESC,ZTRTN,ZTSAVE,ZTPRI,ZTSK
;Make sure its not already running
S STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")
;Its already running and shouldn't be restarted
I STOP="NO" W !,"Process is already running",!!! H 3 Q
S ZTIO=""
S ZTPRI=1
S ZTDESC="Load Patient Data to EDR"
S ZTRTN="RESTPT^BADEEVNT"
S ZTSAVE("DUZ")=""
D ^%ZTLOAD
I $G(ZTSK) D
.D EN^XPAR("SYS","BADE EDR LOAD TSK",,ZTSK)
.W !,"Task number "_ZTSK H 2
Q
RESTPT ;EP Restart the patient load
N DFN,CNT,CNTCHK,TOTAL,DATA,STOP
;Get the last used DFN from the parameter
S DFN=$$GET^XPAR("ALL","BADE EDR LAST DFN")
;Set the stop parameter to NO
D EN^XPAR("SYS","BADE EDR PAUSE PATIENT LOAD",,0)
;Get the total count
S TOTAL=$$GET^XPAR("ALL","BADE EDR TOTAL PROCESSED")
S CNTCHK=$$GET^XPAR("ALL","BADE EDR THROTTLE CT")
;Task off the job of restarting
LOOP2 S CNT=0,STOP="NO"
S DFN=$S(DFN>0:DFN,1:0)
F S DFN=$O(^DPT(DFN)) Q:+DFN'>0!(STOP="YES") D
.K PATNO
.S PATNO=$P($G(^AUPNPAT(DFN,0)),"^",1) ; IHS/MSC/VAC 9/2010 make sure patient # exists
.Q:PATNO'=DFN
.S PATNO=$D(^AUPNPAT(DFN,41))
.Q:PATNO=""
.S CNT=CNT+1
.S BADELOAD=1
.D A28^BADEEVNT(DFN)
.K BADELOAD
.;Set IEN into the DFN parameter
.D EN^XPAR("SYS","BADE EDR LAST DFN",1,"`"_DFN)
.;Add to total count
.S TOTAL=TOTAL+1
.D EN^XPAR("SYS","BADE EDR TOTAL PROCESSED",1,TOTAL)
.;See if we should stop
.S STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")
.Q:STOP="YES"
.;if count=parameter value check throttle parameter
.I CNT=CNTCHK D
..S THROTTLE=$$GET^XPAR("ALL","BADE EDR PT THROTTLE")
..S CNTCHK=$$GET^XPAR("ALL","BADE EDR THROTTLE CT")
..I THROTTLE>0 H THROTTLE
..S CNT=0
;Finish up by resetting the pt parameter to null and the stop parameter to YES
I STOP="NO" D
.D EN^XPAR("SYS","BADE EDR PAUSE PATIENT LOAD",1,1)
.D EN^XPAR("SYS","BADE EDR LOAD TSK",1,"Upload complete")
.D COMPLETE
Q
; IHS/MSC/AMF 10/2010 modified to mark all provider upload options complete
COMPLETE ;Mark options out of order
N MSG,MENU,I
S MENU(1)="BADE EDR UPLOAD ALL PATIENTS"
S MENU(2)="BADE EDR RESTART PAT UPLOAD"
S MENU(3)="BADE EDR PAUSE PATIENT LOAD"
S MENU(4)="BADE EDR PT THROTTLE"
S MENU(5)="BADE EDR THROTTLE CT"
F I=1:1:5 D
.N DA,DIE,DR
.S MSG="Upload completed"
.S DA=$O(^DIC(19,"B",MENU(I),""))
.I DA'="" D
..S DIE="^DIC(19,",DR="2///^S X=MSG"
..D ^DIE
; Enable event protocols
D EDPROT^BADEUTIL("BADE PATIENT A28")
D EDPROT^BADEUTIL("BADE PATIENT A31")
Q
SENDA28 ;Send one A28 message
N ERR,DIC,DT,DFN,Y
S DIC=2,DIC("A")=" Select Patient: ",DIC(0)="AEQMZ",DT=$$DT^XLFDT D ^DIC I +Y>0 D
.S DFN=+Y
.D A28(DFN)
.I '$D(ERR) W !,"Message was sent"
.E W !,"Unable to send HL7 message"
S DIR(0)="EA",DIR("?")="",DIR("A")="Press ENTER to continue..." D ^DIR K DIR ;IHS/MSC/AMF 11/23/10 Remove H 2
Q
SENDA31 ;Send one A31 message
N ERR,DIC,DT,DFN,BADERR,Y
S DIC=2,DIC("A")=" Select Patient: ",DIC(0)="AEQMZ",DT=$$DT^XLFDT D ^DIC I +Y>0 D
.S DFN=+Y
.D A31(DFN)
.I '$D(ERR) W !,"Message was sent"
.E W !,"Unable to send HL7 message"
S DIR(0)="EA",DIR("?")="",DIR("A")="Press ENTER to continue..." D ^DIR K DIR W ! ;IHS/MSC/AMF 11/23/10 Remove H 2
Q
A28(DFN) ;EP Create and send one A28 message
N EVNTTYPE,DOD
S EVNTTYPE="A28"
;If patient has been merged, send the merged DFN
Q:$D(^DPT(DFN,-9))
I '$D(^DPT(DFN,0)) S ERR="No zero node for patient. Cannot send A28." D NOTIF^BADEHL1(DFN,ERR) Q ;IHS/MSC/AMF 11/23/10 descriptive alert
;Patient must be alive
S DOD=$P($G(^DPT(DFN,.35)),U,1)
I DOD="" D NEWMSG^BADEHL1(DFN,EVNTTYPE)
Q
A31(DFN) ;EP Create and send one A31 message
N EVNTTYPE,DOD
S EVNTTYPE="A31"
I '$D(^DPT(DFN,0)) S ERR="No zero node for patient. Cannot send A31." D NOTIF^BADEHL1(DFN,ERR) Q ;IHS/MSC/AMF 11/23/10 descriptive alert
;Don't send if patient is deceased
;S DOD=$P($G(^DPT(DFN,.35)),U,1)
;I DOD=""
D NEWMSG^BADEHL1(DFN,EVNTTYPE)
Q
MSA ;EP
N MSA,HLST
D SET(.ARY,"MSA",0)
D SET(.ARY,"AA",1)
D SET(.ARY,"TODO-MSGID",2)
D SET(.ARY,"Transaction Successful",3)
D SET(.ARY,"todo-010",4)
S MSA=$$ADDSEG^HLOAPI(.HLST,.ARY)
Q
SET(ARY,V,F,C,S,R) ;EP
D SET^HLOAPI(.ARY,.V,.F,.C,.S,.R)
Q
BADEEVNT ;IHS/MSC/MGH - Dentrix HL7 interface ;30-Jun-2009 15:26;PLS
+1 ;;1.0;DENTAL/EDR INTERFACE;**1**;AUG 22, 2011
+2 ;; Modified - IHS/MSC/AMF - 11/23/10 - Updated Out of Order, alerts, removed H 2
+3 ;; Modified - IHS/MSC/VAC 9/2010 check for patient # in AUPNPAT
+4 QUIT
TLOADPT ;EP Taskman call to start patient load
+1 NEW STOP,ZTDTH,ZTIO,ZTDESC,ZTRTN,ZTSAVE,ZTPRI,ZTSK
+2 ;Make sure its not already running
+3 SET STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")
+4 ;Its already running and shouldn't be restarted
+5 IF STOP="NO"
Begin DoDot:1
+6 WRITE !,"Process is already running",!
End DoDot:1
HANG 3
QUIT
+7 IF $$GET^XPAR("ALL","BADE EDR LAST DFN")
Begin DoDot:1
+8 WRITE !,"Upload process has already begun. Please use Restart option.",!
End DoDot:1
HANG 3
QUIT
+9 SET ZTIO=""
+10 SET ZTPRI=1
+11 SET ZTDESC="Load Patient Data to EDR"
+12 SET ZTRTN="LOADPT^BADEEVNT"
+13 SET ZTSAVE("DUZ")=""
+14 DO ^%ZTLOAD
+15 IF $GET(ZTSK)
Begin DoDot:1
+16 DO EN^XPAR("SYS","BADE EDR LOAD TSK",1,ZTSK)
+17 WRITE !,"Task number "_ZTSK
HANG 2
End DoDot:1
+18 QUIT
LOADPT ;EP Load all patient's data
+1 NEW DFN,CNT,CNTCHK,DATA,TOTAL,STOP,THROTTLE,BADELOAD
+2 ;Make sure the stop parameter is NO
+3 DO EN^XPAR("SYS","BADE EDR PAUSE PATIENT LOAD",1,"NO")
+4 ;Make sure the Pt DFN is set to null
+5 SET DFN=$$GET^XPAR("ALL","BADE EDR LAST DFN")
+6 ;Check to see how many patients to process before throttling
+7 SET CNTCHK=$$GET^XPAR("ALL","BADE EDR THROTTLE CT")
+8 ;Loop through the patients and send data
LOOP SET DFN=$SELECT(DFN>0:DFN,1:0)
SET CNT=0
SET STOP="NO"
SET TOTAL=0
+1 FOR
SET DFN=$ORDER(^DPT(DFN))
IF +DFN'>0!(STOP="YES")
QUIT
Begin DoDot:1
+2 KILL PATNO
+3 ; IHS/MSC/VAC 9/2010 make sure patient # exists
SET PATNO=$PIECE($GET(^AUPNPAT(DFN,0)),"^",1)
+4 IF PATNO'=DFN
QUIT
+5 SET PATNO=$DATA(^AUPNPAT(DFN,41))
+6 IF PATNO=""
QUIT
+7 SET CNT=CNT+1
+8 SET BADELOAD=1
+9 DO A28^BADEEVNT(DFN)
+10 KILL BADELOAD
+11 ;Set IEN into the DFN parameter
+12 DO EN^XPAR("SYS","BADE EDR LAST DFN",1,"`"_DFN)
+13 ;Add to total count
+14 SET TOTAL=TOTAL+1
+15 DO EN^XPAR("SYS","BADE EDR TOTAL PROCESSED",1,TOTAL)
+16 ;Check to see if we should stop
+17 SET STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")
+18 IF STOP="YES"
QUIT
+19 ;If count=check throttle parameter
+20 IF CNT=CNTCHK
Begin DoDot:2
+21 SET THROTTLE=$$GET^XPAR("ALL","BADE EDR PT THROTTLE")
+22 SET CNTCHK=$$GET^XPAR("ALL","BADE EDR THROTTLE CT")
+23 IF THROTTLE>0
HANG THROTTLE
+24 SET CNT=0
End DoDot:2
End DoDot:1
+25 ;Finish up by resetting the pt parameter to null and the stop paramater to YES
+26 IF STOP="NO"
Begin DoDot:1
+27 DO EN^XPAR("SYS","BADE EDR PAUSE PATIENT LOAD",1,"YES")
+28 DO EN^XPAR("SYS","BADE EDR LOAD TSK",1,"Upload complete")
+29 DO COMPLETE
End DoDot:1
+30 QUIT
TRESTRT ;EP Taskman call to restart patient load
+1 NEW STOP,ZTDTH,ZTIO,ZTDESC,ZTRTN,ZTSAVE,ZTPRI,ZTSK
+2 ;Make sure its not already running
+3 SET STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")
+4 ;Its already running and shouldn't be restarted
+5 IF STOP="NO"
WRITE !,"Process is already running",!!!
HANG 3
QUIT
+6 SET ZTIO=""
+7 SET ZTPRI=1
+8 SET ZTDESC="Load Patient Data to EDR"
+9 SET ZTRTN="RESTPT^BADEEVNT"
+10 SET ZTSAVE("DUZ")=""
+11 DO ^%ZTLOAD
+12 IF $GET(ZTSK)
Begin DoDot:1
+13 DO EN^XPAR("SYS","BADE EDR LOAD TSK",,ZTSK)
+14 WRITE !,"Task number "_ZTSK
HANG 2
End DoDot:1
+15 QUIT
RESTPT ;EP Restart the patient load
+1 NEW DFN,CNT,CNTCHK,TOTAL,DATA,STOP
+2 ;Get the last used DFN from the parameter
+3 SET DFN=$$GET^XPAR("ALL","BADE EDR LAST DFN")
+4 ;Set the stop parameter to NO
+5 DO EN^XPAR("SYS","BADE EDR PAUSE PATIENT LOAD",,0)
+6 ;Get the total count
+7 SET TOTAL=$$GET^XPAR("ALL","BADE EDR TOTAL PROCESSED")
+8 SET CNTCHK=$$GET^XPAR("ALL","BADE EDR THROTTLE CT")
+9 ;Task off the job of restarting
LOOP2 SET CNT=0
SET STOP="NO"
+1 SET DFN=$SELECT(DFN>0:DFN,1:0)
+2 FOR
SET DFN=$ORDER(^DPT(DFN))
IF +DFN'>0!(STOP="YES")
QUIT
Begin DoDot:1
+3 KILL PATNO
+4 ; IHS/MSC/VAC 9/2010 make sure patient # exists
SET PATNO=$PIECE($GET(^AUPNPAT(DFN,0)),"^",1)
+5 IF PATNO'=DFN
QUIT
+6 SET PATNO=$DATA(^AUPNPAT(DFN,41))
+7 IF PATNO=""
QUIT
+8 SET CNT=CNT+1
+9 SET BADELOAD=1
+10 DO A28^BADEEVNT(DFN)
+11 KILL BADELOAD
+12 ;Set IEN into the DFN parameter
+13 DO EN^XPAR("SYS","BADE EDR LAST DFN",1,"`"_DFN)
+14 ;Add to total count
+15 SET TOTAL=TOTAL+1
+16 DO EN^XPAR("SYS","BADE EDR TOTAL PROCESSED",1,TOTAL)
+17 ;See if we should stop
+18 SET STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")
+19 IF STOP="YES"
QUIT
+20 ;if count=parameter value check throttle parameter
+21 IF CNT=CNTCHK
Begin DoDot:2
+22 SET THROTTLE=$$GET^XPAR("ALL","BADE EDR PT THROTTLE")
+23 SET CNTCHK=$$GET^XPAR("ALL","BADE EDR THROTTLE CT")
+24 IF THROTTLE>0
HANG THROTTLE
+25 SET CNT=0
End DoDot:2
End DoDot:1
+26 ;Finish up by resetting the pt parameter to null and the stop parameter to YES
+27 IF STOP="NO"
Begin DoDot:1
+28 DO EN^XPAR("SYS","BADE EDR PAUSE PATIENT LOAD",1,1)
+29 DO EN^XPAR("SYS","BADE EDR LOAD TSK",1,"Upload complete")
+30 DO COMPLETE
End DoDot:1
+31 QUIT
+32 ; IHS/MSC/AMF 10/2010 modified to mark all provider upload options complete
COMPLETE ;Mark options out of order
+1 NEW MSG,MENU,I
+2 SET MENU(1)="BADE EDR UPLOAD ALL PATIENTS"
+3 SET MENU(2)="BADE EDR RESTART PAT UPLOAD"
+4 SET MENU(3)="BADE EDR PAUSE PATIENT LOAD"
+5 SET MENU(4)="BADE EDR PT THROTTLE"
+6 SET MENU(5)="BADE EDR THROTTLE CT"
+7 FOR I=1:1:5
Begin DoDot:1
+8 NEW DA,DIE,DR
+9 SET MSG="Upload completed"
+10 SET DA=$ORDER(^DIC(19,"B",MENU(I),""))
+11 IF DA'=""
Begin DoDot:2
+12 SET DIE="^DIC(19,"
SET DR="2///^S X=MSG"
+13 DO ^DIE
End DoDot:2
End DoDot:1
+14 ; Enable event protocols
+15 DO EDPROT^BADEUTIL("BADE PATIENT A28")
+16 DO EDPROT^BADEUTIL("BADE PATIENT A31")
+17 QUIT
SENDA28 ;Send one A28 message
+1 NEW ERR,DIC,DT,DFN,Y
+2 SET DIC=2
SET DIC("A")=" Select Patient: "
SET DIC(0)="AEQMZ"
SET DT=$$DT^XLFDT
DO ^DIC
IF +Y>0
Begin DoDot:1
+3 SET DFN=+Y
+4 DO A28(DFN)
+5 IF '$DATA(ERR)
WRITE !,"Message was sent"
+6 IF '$TEST
WRITE !,"Unable to send HL7 message"
End DoDot:1
+7 ;IHS/MSC/AMF 11/23/10 Remove H 2
SET DIR(0)="EA"
SET DIR("?")=""
SET DIR("A")="Press ENTER to continue..."
DO ^DIR
KILL DIR
+8 QUIT
SENDA31 ;Send one A31 message
+1 NEW ERR,DIC,DT,DFN,BADERR,Y
+2 SET DIC=2
SET DIC("A")=" Select Patient: "
SET DIC(0)="AEQMZ"
SET DT=$$DT^XLFDT
DO ^DIC
IF +Y>0
Begin DoDot:1
+3 SET DFN=+Y
+4 DO A31(DFN)
+5 IF '$DATA(ERR)
WRITE !,"Message was sent"
+6 IF '$TEST
WRITE !,"Unable to send HL7 message"
End DoDot:1
+7 ;IHS/MSC/AMF 11/23/10 Remove H 2
SET DIR(0)="EA"
SET DIR("?")=""
SET DIR("A")="Press ENTER to continue..."
DO ^DIR
KILL DIR
WRITE !
+8 QUIT
A28(DFN) ;EP Create and send one A28 message
+1 NEW EVNTTYPE,DOD
+2 SET EVNTTYPE="A28"
+3 ;If patient has been merged, send the merged DFN
+4 IF $DATA(^DPT(DFN,-9))
QUIT
+5 ;IHS/MSC/AMF 11/23/10 descriptive alert
IF '$DATA(^DPT(DFN,0))
SET ERR="No zero node for patient. Cannot send A28."
DO NOTIF^BADEHL1(DFN,ERR)
QUIT
+6 ;Patient must be alive
+7 SET DOD=$PIECE($GET(^DPT(DFN,.35)),U,1)
+8 IF DOD=""
DO NEWMSG^BADEHL1(DFN,EVNTTYPE)
+9 QUIT
A31(DFN) ;EP Create and send one A31 message
+1 NEW EVNTTYPE,DOD
+2 SET EVNTTYPE="A31"
+3 ;IHS/MSC/AMF 11/23/10 descriptive alert
IF '$DATA(^DPT(DFN,0))
SET ERR="No zero node for patient. Cannot send A31."
DO NOTIF^BADEHL1(DFN,ERR)
QUIT
+4 ;Don't send if patient is deceased
+5 ;S DOD=$P($G(^DPT(DFN,.35)),U,1)
+6 ;I DOD=""
+7 DO NEWMSG^BADEHL1(DFN,EVNTTYPE)
+8 QUIT
MSA ;EP
+1 NEW MSA,HLST
+2 DO SET(.ARY,"MSA",0)
+3 DO SET(.ARY,"AA",1)
+4 DO SET(.ARY,"TODO-MSGID",2)
+5 DO SET(.ARY,"Transaction Successful",3)
+6 DO SET(.ARY,"todo-010",4)
+7 SET MSA=$$ADDSEG^HLOAPI(.HLST,.ARY)
+8 QUIT
SET(ARY,V,F,C,S,R) ;EP
+1 DO SET^HLOAPI(.ARY,.V,.F,.C,.S,.R)
+2 QUIT
