BADEMRG ;IHS/MSC/MGH - Dentrix HL7 interface ;31-Aug-2010 13:46;EDR
;;1.0;DENTAL/EDR INTERFACE;**1**;AUG 22, 2011
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 MRG LOAD",1,"E")
;Its already running and shouldn't be restarted
I STOP="NO" D H 3 Q
.W !,"Merge Upload is already running",!
I $$GET^XPAR("ALL","BADE EDR MRG DFN") D H 3 Q
.W !,"Upload process has already begun. Please use Restart option.",!
S ZTIO=""
S ZTPRI=1
S ZTDESC="Load Patient Merge Data to EDR"
S ZTRTN="LOADPT^BADEMRG"
S ZTSAVE("DUZ")=""
D ^%ZTLOAD
I $G(ZTSK) D
.D EN^XPAR("SYS","BADE EDR MRG LOAD TSK",1,ZTSK)
.W !,"Task number "_ZTSK H 2
Q
LOADPT ;EP Load all patient's data
N FDFN,CNT,CNTCHK,DATA,TOTAL,STOP,THROTTLE,RESULT
;Make sure the stop parameter is NO
D EN^XPAR("SYS","BADE EDR PAUSE MRG LOAD",1,"NO")
;Set the dfn to null
S FDFN=$$GET^XPAR("ALL","BADE EDR MRG DFN")
;Loop through the patients and send data
LOOP S FDFN=$S(FDFN>0:FDFN,1:0),CNT=0,STOP="NO",TOTAL=0
F S FDFN=$O(^DPT(FDFN)) Q:+FDFN'>0!(STOP="YES") D
.Q:'$D(^DPT(FDFN,-9)) ;Patient has not been merged
.;If patient was merged, find the merged to patient and send A40 message
.;and an A31 message on the merged to patient
.S RESULT=""
.S RESULT=$$MRGTODFN^BADEUTIL(FDFN)
.D A40(FDFN,RESULT)
.D A31(RESULT)
.;Set IEN into the DFN parameter
.D EN^XPAR("SYS","BADE EDR MRG DFN",1,FDFN)
.;Add to total count
.S TOTAL=TOTAL+1
.D EN^XPAR("SYS","BADE EDR MRG TOTAL",1,TOTAL)
.;Check to see if we should stop
.S STOP=$$GET^XPAR("ALL","BADE EDR PAUSE MRG LOAD",1,"E")
.Q:STOP="YES"
;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 MRG LOAD",1,"YES")
.D EN^XPAR("SYS","BADE EDR MRG LOAD TSK",1,"Upload complete")
.D COMPLETE("DONE")
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 MRG 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 Merge Data to EDR"
S ZTRTN="RESTPT^BADEMRG"
S ZTSAVE("DUZ")=""
D ^%ZTLOAD
I $G(ZTSK) D
.D EN^XPAR("SYS","BADE EDR MRG LOAD TSK",,ZTSK)
.W !,"Task number "_ZTSK H 2
Q
RESTPT ;EP Restart the patient load
N FDFN,CNT,CNTCHK,TOTAL,DATA,STOP,RESULT
;Get the last used DFN from the parameter
S FDFN=$$GET^XPAR("ALL","BADE EDR MRG DFN")
;Set the stop parameter to NO
D EN^XPAR("SYS","BADE EDR PAUSE MRG LOAD",,0)
;Get the total count
S TOTAL=$$GET^XPAR("ALL","BADE EDR MRG TOTAL")
;Task off the job of restarting
LOOP2 S CNT=0,STOP="NO"
S FDFN=$S(FDFN>0:FDFN,1:0)
F S FDFN=$O(^DPT(FDFN)) Q:+FDFN'>0!(STOP="YES") D
.Q:'$D(^DPT(FDFN,-9)) ;Patient has not been merged
.;If patient was merged, find the merged to patient and send A40 messag
.;and an A31 message on the merged to patient
.S RESULT=""
.S RESULT=$$MRGTODFN^BADEUTIL(FDFN)
.D A40(FDFN,RESULT)
.D A31(RESULT)
.;Send message if patient was merged
.;Set IEN into the DFN parameter
.D EN^XPAR("SYS","BADE EDR MRG DFN",1,FDFN)
.;Add to total count
.S TOTAL=TOTAL+1
.D EN^XPAR("SYS","BADE EDR MRG TOTAL",1,TOTAL)
.;See if we should stop
.S STOP=$$GET^XPAR("ALL","BADE EDR PAUSE MRG LOAD",1,"E")
.Q:STOP="YES"
;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 MRG LOAD",1,1)
.D EN^XPAR("SYS","BADE EDR MRG LOAD TSK",1,"Upload complete")
.D COMPLETE("DONE")
Q
COMPLETE(WHICH) ;Mark options out of order
N MSG,MENU,I
S MENU(1)="BADE EDR UPLOAD ALL MERGED PTS"
S MENU(2)="BADE EDR RESTART MRG UPLOAD"
S MENU(3)="BADE EDR PAUSE MRG LOAD"
S MENU(4)="BADE EDR SEND A40"
F I=1:1:4 D
.N DA,DIE,DR
.I (WHICH="DONE"),(I=4) Q
.S MSG=$S(WHICH="DONE":"Upload completed",1:"Patient merge not installed")
.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 A40")
Q
SENDA40 ;Send one A40 message
N ERR,DIC,DIR,DT,DFN,DFN2,BADERR,X,Y,RESULT,ARRAY,CNT,NAME,QUIT
S CNT=0
S DIC=2,DIC("A")=" Select Patient: ",DIC(0)="AEQMZ",DT=$$DT^XLFDT
D ^DIC I Y=-1 G SENDX
I +Y>0 D
.S DFN=+Y
.Q:'DFN
.S NAME=$P($G(^DPT(DFN,0)),U,1)
.S DFN2=0 F S DFN2=$O(^DPT(DFN2)) Q:'+DFN2 D
..Q:'$D(^DPT(DFN2,-9))
..S RESULT=$$MRGTODFN^BADEUTIL(DFN2)
..I RESULT=DFN D
...S CNT=CNT+1
...S ARRAY(CNT)=DFN2_U_$P($G(^DPT(DFN2,0)),U,1)
I CNT=0 W !,"There were no patients merged to "_NAME G SENDA40
S QUIT=0
I CNT>0 D
.N I
.S I=0 F S I=$O(ARRAY(I)) Q:I="" D
..W !,CNT,?10,$P(ARRAY(I),U,2)
..S DIR(0)="N",DIR("A")="Select the MERGED FROM PT" D ^DIR
..I '$D(ARRAY(X)) W !,"Invalid Selection, Try again" S QUIT=1
..E S FROM=$P(ARRAY(X),U,1),TO=DFN D MSG(FROM,TO)
I QUIT G SENDA40
Q
SENDX Q
MSG(FROM,TO) ;EP to send A40 and A31 messages
D A40(FROM,TO)
I $D(ERR) W !,"Unable to send HL7 message" H 2 Q
D A31(TO)
I '$D(ERR) W !,"Message was sent" H 2
I $D(ERR) W !,"Unable to send HL7 message" H 2
Q
A40(FROM,TO) ;EP Create and send one A40 message
N EVNTTYPE
S EVNTTYPE="A40"
D NEWMSG^BADEMRG1(FROM,TO,EVNTTYPE)
Q
A31(DFN) ;EP Create and send one A31 message
N EVNTTYPE,DOD
S EVNTTYPE="A31"
I '$D(^DPT(DFN,0)) D NOTIF^BADEHL1(DFN,"Missing zero node. Cannot create A31.") Q
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
BADEMRG ;IHS/MSC/MGH - Dentrix HL7 interface ;31-Aug-2010 13:46;EDR
+1 ;;1.0;DENTAL/EDR INTERFACE;**1**;AUG 22, 2011
+2 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 MRG LOAD",1,"E")
+4 ;Its already running and shouldn't be restarted
+5 IF STOP="NO"
Begin DoDot:1
+6 WRITE !,"Merge Upload is already running",!
End DoDot:1
HANG 3
QUIT
+7 IF $$GET^XPAR("ALL","BADE EDR MRG 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 Merge Data to EDR"
+12 SET ZTRTN="LOADPT^BADEMRG"
+13 SET ZTSAVE("DUZ")=""
+14 DO ^%ZTLOAD
+15 IF $GET(ZTSK)
Begin DoDot:1
+16 DO EN^XPAR("SYS","BADE EDR MRG 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 FDFN,CNT,CNTCHK,DATA,TOTAL,STOP,THROTTLE,RESULT
+2 ;Make sure the stop parameter is NO
+3 DO EN^XPAR("SYS","BADE EDR PAUSE MRG LOAD",1,"NO")
+4 ;Set the dfn to null
+5 SET FDFN=$$GET^XPAR("ALL","BADE EDR MRG DFN")
+6 ;Loop through the patients and send data
LOOP SET FDFN=$SELECT(FDFN>0:FDFN,1:0)
SET CNT=0
SET STOP="NO"
SET TOTAL=0
+1 FOR
SET FDFN=$ORDER(^DPT(FDFN))
IF +FDFN'>0!(STOP="YES")
QUIT
Begin DoDot:1
+2 ;Patient has not been merged
IF '$DATA(^DPT(FDFN,-9))
QUIT
+3 ;If patient was merged, find the merged to patient and send A40 message
+4 ;and an A31 message on the merged to patient
+5 SET RESULT=""
+6 SET RESULT=$$MRGTODFN^BADEUTIL(FDFN)
+7 DO A40(FDFN,RESULT)
+8 DO A31(RESULT)
+9 ;Set IEN into the DFN parameter
+10 DO EN^XPAR("SYS","BADE EDR MRG DFN",1,FDFN)
+11 ;Add to total count
+12 SET TOTAL=TOTAL+1
+13 DO EN^XPAR("SYS","BADE EDR MRG TOTAL",1,TOTAL)
+14 ;Check to see if we should stop
+15 SET STOP=$$GET^XPAR("ALL","BADE EDR PAUSE MRG LOAD",1,"E")
+16 IF STOP="YES"
QUIT
End DoDot:1
+17 ;Finish up by resetting the pt parameter to null and the stop paramater to YES
+18 IF STOP="NO"
Begin DoDot:1
+19 DO EN^XPAR("SYS","BADE EDR PAUSE MRG LOAD",1,"YES")
+20 DO EN^XPAR("SYS","BADE EDR MRG LOAD TSK",1,"Upload complete")
+21 DO COMPLETE("DONE")
End DoDot:1
+22 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 MRG 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 Merge Data to EDR"
+9 SET ZTRTN="RESTPT^BADEMRG"
+10 SET ZTSAVE("DUZ")=""
+11 DO ^%ZTLOAD
+12 IF $GET(ZTSK)
Begin DoDot:1
+13 DO EN^XPAR("SYS","BADE EDR MRG LOAD TSK",,ZTSK)
+14 WRITE !,"Task number "_ZTSK
HANG 2
End DoDot:1
+15 QUIT
RESTPT ;EP Restart the patient load
+1 NEW FDFN,CNT,CNTCHK,TOTAL,DATA,STOP,RESULT
+2 ;Get the last used DFN from the parameter
+3 SET FDFN=$$GET^XPAR("ALL","BADE EDR MRG DFN")
+4 ;Set the stop parameter to NO
+5 DO EN^XPAR("SYS","BADE EDR PAUSE MRG LOAD",,0)
+6 ;Get the total count
+7 SET TOTAL=$$GET^XPAR("ALL","BADE EDR MRG TOTAL")
+8 ;Task off the job of restarting
LOOP2 SET CNT=0
SET STOP="NO"
+1 SET FDFN=$SELECT(FDFN>0:FDFN,1:0)
+2 FOR
SET FDFN=$ORDER(^DPT(FDFN))
IF +FDFN'>0!(STOP="YES")
QUIT
Begin DoDot:1
+3 ;Patient has not been merged
IF '$DATA(^DPT(FDFN,-9))
QUIT
+4 ;If patient was merged, find the merged to patient and send A40 messag
+5 ;and an A31 message on the merged to patient
+6 SET RESULT=""
+7 SET RESULT=$$MRGTODFN^BADEUTIL(FDFN)
+8 DO A40(FDFN,RESULT)
+9 DO A31(RESULT)
+10 ;Send message if patient was merged
+11 ;Set IEN into the DFN parameter
+12 DO EN^XPAR("SYS","BADE EDR MRG DFN",1,FDFN)
+13 ;Add to total count
+14 SET TOTAL=TOTAL+1
+15 DO EN^XPAR("SYS","BADE EDR MRG TOTAL",1,TOTAL)
+16 ;See if we should stop
+17 SET STOP=$$GET^XPAR("ALL","BADE EDR PAUSE MRG LOAD",1,"E")
+18 IF STOP="YES"
QUIT
End DoDot:1
+19 ;Finish up by resetting the pt parameter to null and the stop parameter to YES
+20 IF STOP="NO"
Begin DoDot:1
+21 DO EN^XPAR("SYS","BADE EDR PAUSE MRG LOAD",1,1)
+22 DO EN^XPAR("SYS","BADE EDR MRG LOAD TSK",1,"Upload complete")
+23 DO COMPLETE("DONE")
End DoDot:1
+24 QUIT
COMPLETE(WHICH) ;Mark options out of order
+1 NEW MSG,MENU,I
+2 SET MENU(1)="BADE EDR UPLOAD ALL MERGED PTS"
+3 SET MENU(2)="BADE EDR RESTART MRG UPLOAD"
+4 SET MENU(3)="BADE EDR PAUSE MRG LOAD"
+5 SET MENU(4)="BADE EDR SEND A40"
+6 FOR I=1:1:4
Begin DoDot:1
+7 NEW DA,DIE,DR
+8 IF (WHICH="DONE")
IF (I=4)
QUIT
+9 SET MSG=$SELECT(WHICH="DONE":"Upload completed",1:"Patient merge not installed")
+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 A40")
+16 QUIT
SENDA40 ;Send one A40 message
+1 NEW ERR,DIC,DIR,DT,DFN,DFN2,BADERR,X,Y,RESULT,ARRAY,CNT,NAME,QUIT
+2 SET CNT=0
+3 SET DIC=2
SET DIC("A")=" Select Patient: "
SET DIC(0)="AEQMZ"
SET DT=$$DT^XLFDT
+4 DO ^DIC
IF Y=-1
GOTO SENDX
+5 IF +Y>0
Begin DoDot:1
+6 SET DFN=+Y
+7 IF 'DFN
QUIT
+8 SET NAME=$PIECE($GET(^DPT(DFN,0)),U,1)
+9 SET DFN2=0
FOR
SET DFN2=$ORDER(^DPT(DFN2))
IF '+DFN2
QUIT
Begin DoDot:2
+10 IF '$DATA(^DPT(DFN2,-9))
QUIT
+11 SET RESULT=$$MRGTODFN^BADEUTIL(DFN2)
+12 IF RESULT=DFN
Begin DoDot:3
+13 SET CNT=CNT+1
+14 SET ARRAY(CNT)=DFN2_U_$PIECE($GET(^DPT(DFN2,0)),U,1)
End DoDot:3
End DoDot:2
End DoDot:1
+15 IF CNT=0
WRITE !,"There were no patients merged to "_NAME
GOTO SENDA40
+16 SET QUIT=0
+17 IF CNT>0
Begin DoDot:1
+18 NEW I
+19 SET I=0
FOR
SET I=$ORDER(ARRAY(I))
IF I=""
QUIT
Begin DoDot:2
+20 WRITE !,CNT,?10,$PIECE(ARRAY(I),U,2)
+21 SET DIR(0)="N"
SET DIR("A")="Select the MERGED FROM PT"
DO ^DIR
+22 IF '$DATA(ARRAY(X))
WRITE !,"Invalid Selection, Try again"
SET QUIT=1
+23 IF '$TEST
SET FROM=$PIECE(ARRAY(X),U,1)
SET TO=DFN
DO MSG(FROM,TO)
End DoDot:2
End DoDot:1
+24 IF QUIT
GOTO SENDA40
+25 QUIT
SENDX QUIT
MSG(FROM,TO) ;EP to send A40 and A31 messages
+1 DO A40(FROM,TO)
+2 IF $DATA(ERR)
WRITE !,"Unable to send HL7 message"
HANG 2
QUIT
+3 DO A31(TO)
+4 IF '$DATA(ERR)
WRITE !,"Message was sent"
HANG 2
+5 IF $DATA(ERR)
WRITE !,"Unable to send HL7 message"
HANG 2
+6 QUIT
A40(FROM,TO) ;EP Create and send one A40 message
+1 NEW EVNTTYPE
+2 SET EVNTTYPE="A40"
+3 DO NEWMSG^BADEMRG1(FROM,TO,EVNTTYPE)
+4 QUIT
A31(DFN) ;EP Create and send one A31 message
+1 NEW EVNTTYPE,DOD
+2 SET EVNTTYPE="A31"
+3 IF '$DATA(^DPT(DFN,0))
DO NOTIF^BADEHL1(DFN,"Missing zero node. Cannot create A31.")
QUIT
+4 DO NEWMSG^BADEHL1(DFN,EVNTTYPE)
+5 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
