Routine: BADEMRG

BADEMRG ;IHS/MSC/MGH - Dentrix HL7 interface  ;31-Aug-2010 13:46;EDR

 ;;1.0;DENTAL/EDR INTERFACE;**1**;AUG 22, 2011

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

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")

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

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")

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")

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

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

A40(FROM,TO) ;EP Create and send one A40 message

 N EVNTTYPE

 S EVNTTYPE="A40"

 D NEWMSG^BADEMRG1(FROM,TO,EVNTTYPE)

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)

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)

SET(ARY,V,F,C,S,R) ;EP

 D SET^HLOAPI(.ARY,.V,.F,.C,.S,.R)

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

BADEMRG.m