AGMPHLU.m

AGMPHLU ; IHS/SD/TPF - MPI HLO MSG UTILITIES ; 12/15/2007

 ;;7.2;IHS PATIENT REGISTRATION;**1,3,5,6**;MAY 20, 2010;Build 23

 Q

 ;

DIRCON ;EP - SEND A DIRECT CONNECT VQQ-Q02

 ; 09/06/2017 - GCD - CR 7693 - Disabled VQQ messages because they are buggy and not needed.

 W !!,"THIS OPTION HAS BEEN DISABLED" Q

 W !!,"ENTER PATIENT YOU WISH TO QUERY THE MPI FOR:"

 W !

 D PTLK^AG

 Q:'$D(DFN)

 I $$DEMOPAT(DFN) W !!,"Demo patients may not be uploaded to the MPI." G DIRCON  ; 9/13/2017 - GCD - CR 7713 - Don't upload demo patients.

 D CREATMSG^AGMPIHLO(DFN,"VTQ",,.SUCCESS)

 I SUCCESS D  Q

 .W !!,"Query message "_$G(SUCCESS)_" has been sent to the MPI"

 W !,"Unable to query patient "_$P(^DPT(DFN,0),U)_" on MPI"

 Q

 ;

A28 ;EP - SEND A A28 ADD A PATIENT

 W !!,"ENTER PATIENT YOU WISH TO ADD TO THE MPI:"

 D PTLK^AG

 Q:'$D(DFN)

 I $$DEMOPAT(DFN) W !!,"Demo patients may not be uploaded to the MPI." G A28  ; 9/13/2017 - GCD - CR 7713 - Don't upload demo patients.

 D CREATMSG^AGMPIHLO(DFN,"A28",,.SUCCESS)

 I SUCCESS D  Q

 .W !!,"A28 Message "_SUCCESS_" has been sent to add patient "_$P(^DPT(DFN,0),U)_" to the MPI." H 2

 .;05/29/2013 - KJH - TFS8109 - This was causing an extra message to be sent to EDR.

 .;S X="AG REGISTER A PATIENT",DIC=101,INDA=DFN

 .;D EN^XQOR

 W !,"Unable to create A28 to add patient "_$P(^DPT(DFN,0),U)_" to MPI"

 Q

 ;

A08 ;EP - SEND AN A08 UPDATE

 W !!,"EXAMPLE OF AN A08 UPDATE"

 D PTLK^AG

 Q:'$D(DFN)

 I $$DEMOPAT(DFN) W !!,"Demo patients may not be uploaded to the MPI." G A08  ; 9/13/2017 - GCD - CR 7713 - Don't upload demo patients.

 D CREATMSG^AGMPIHLO(DFN,"A08","",.SUCCESS)

 I SUCCESS D  Q

 .W !!,"A08 Message "_SUCCESS_" has been sent to update patient "_$P(^DPT(DFN,0),U)_" on the MPI." H 2

 .;05/29/2013 - KJH - TFS8109 - This was causing an extra message to be sent to EDR.

 .;S X="AG UPDATE A PATIENT",DIC=101,INDA=DFN

 .;D EN^XQOR

 W !,"Unable to create A08 to update patient "_$P(^DPT(DFN,0),U)_" on MPI"

 Q

 ;

VISITMSG ;EP - CREATE A NEW A01 OR A03

 W !!,"CREATE A VISIT HL7 MESSAGE"

 D PTLK^AG

 Q:'$D(DFN)

 I $$DEMOPAT(DFN) W !!,"Demo patients may not be uploaded to the MPI." G VISITMSG  ; 9/13/2017 - GCD - CR 7713 - Don't upload demo patients.

 K DIR

 S DIR(0)="SO^A:ADMISSION;D:DISCHARGE;CIN:CHECK-IN;COUT:CHECK-OUT"

 D ^DIR

 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)!(Y="")

 ;CHECK IN - CHECK OUT

 I Y="CIN"!(Y="COUT") D  Q  Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)!(Y="")

 .S EVENT=$S(Y="CIN":4,1:5)

 .K DIR

 .S DIR(0)="D^::RE"

 .S DIR("A")="ENTER CHECK-"_$S(Y="CIN":"IN",1:"OUT")_" DATE"

 .D ^DIR

 .D NOW^%DTC S NOW=%

 .Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)!(Y="")

 .S DATE=Y

 .D CREATE^AGMPHL01(EVENT,DFN,DATE,.SUCCESS)

 .I SUCCESS D  Q

 ..W !!,$S(EVENT=1:"A01",1:"A03")_" Message IEN "_SUCCESS_" has been sent to update patient"

 ..W !,$P(^DPT(DFN,0),U)_" last treated date on the MPI." H 2

 .W !,"Unable to create "_$S(EVENT=1:"A01",1:"A03")_" to update patient "_$P(^DPT(DFN,0),U)_" on MPI"

 ;

 ;ADMISSION - DISCHARGE

 S TYPE=$S(Y="A":1,1:3)

 K DIR

 S DIR(0)="D^::RE"

 S DIR("A")="ENTER MOVEMENT DATE"

 D ^DIR

 D NOW^%DTC S NOW=%

 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)!(Y="")

 S DATETIME="T"_Y

 D CREATE^AGMPHL03(DFN,TYPE,DATETIME,.SUCCESS)

 I SUCCESS D  Q

 .W !!,$S(TYPE=1:"A01",1:"A03")_" Message IEN "_SUCCESS_" has been sent to update patient"

 .W !,$P(^DPT(DFN,0),U)_" last treated date on the MPI." H 2

 W !,"Unable to create "_$S(TYPE=1:"A01",1:"A03")_" to update patient "_$P(^DPT(DFN,0),U)_" on MPI"

 Q

 ;

A40 ;EP - SEND A40 MERGE FROM/TO

 N DFN1,DFN2,MRGDIR,NAME1,NAME2

PT1 ;ASK FOR FROM PATIENT

 ; AG*7.2*5/CR 7718 - Overhauled this entire section because normal patient lookups don't work on merged patients.

 W !,"ENTER PATIENT TO KEEP:"

 S DIC="^VA(15,",DIC(0)="AEMQ",DIC("A")="Select PATIENT NAME: " D ^DIC

 Q:Y=-1

 S IEN=$P(Y,"^")

 S MRGDIR=$$GET1^DIQ(15,IEN_",",.04,"I")  ; 1=.01->.02, 2=.02->.01

 S DFN1=$P($$GET1^DIQ(15,IEN_",",$S(MRGDIR=1:.01,1:.02),"I"),";")  ; From patient

 S DFN2=$P($$GET1^DIQ(15,IEN_",",$S(MRGDIR=1:.02,1:.01),"I"),";")  ; To patient

 I $$DEMOPAT(DFN1)!$$DEMOPAT(DFN2) W !!,"Demo patients may not be uploaded to the MPI." G PT1  ; 9/13/2017 - GCD - CR 7713 - Don't upload demo patients.

 I $G(^DPT(DFN1,-9))'=DFN2 D  G PT1  ; AG*7.2*5/CR 7718 - Corrected condition -- now checks that patient was merged into DFN2.

 .W !,"THIS PATIENT HAS NOT BEEN MERGED TO FIRST PATIENT SUCCESSFULLY!"

 .K DIR

 .S DIR(0)="E"

 .D ^DIR

 S NAME1=$P($G(^DPT(DFN1,0)),U)  ; ^DIQ doesn't work on merged patients

 S NAME2=$$GET1^DIQ(2,DFN2_",",.01,"I")

 W !

 K DIR

 S DIR(0)="Y",DIR("A")="Send A40 for "_NAME1_" merged into "_NAME2,DIR("B")="Yes"

 D ^DIR

 I Y="^" Q

 I 'Y W ! G PT1

 D CREATMSG^AGMPIHLO(DFN2,"A40",DFN1,.SUCCESS)

 I SUCCESS D  Q

 .W !!,"A40 Message "_SUCCESS_" has been sent to merge patient"

 .W !,$P(^DPT(DFN1,0),U)_" to patient "_$P(^DPT(DFN2,0),U) H 2

 W !,"Unable to merge "_$P(^DPT(DFN1,0),U)_" to patient "_$P(^DPT(DFN2,0),U)_" on MPI" H 2

 Q

 ;

MFNMFK ;EP - PROCESS MFN MESSAGE AND CREATE A MFK RESPONSE

 K DIR,DIC,DA,DIE,DIR

 W !!

 S DIC(0)="AQEM"

 S DIC("S")="I $G(^HLB(Y,2))[""MFN"""

 S DIC="^HLB("

 D ^DIC

 Q:Y<0

 D PROC^AGMPHMFN(+Y,.SUCCESS)

 K DIR,DIC,DA,DIE,DIR

 I SUCCESS D  Q

 .W !!,"MFK Message "_SUCCESS_" has been sent to the MPI" H 2

 W !,"Unable to create MFK message." H 2

 Q

 ;

RESEND ;EP - RESEND MESSAGE(S)

RSAGAIN ;EP

 N FRMSGIEN,TOMSGIEN,DIC,DT,NEWIEN,ERROR,Y

 N MPIDIREC,TOTEVENT,GRDTOTAL,ERRORS

FROM ;EP - ASK FROM

 S (MPIDIREC,TOTEVENT,GRDTOTAL,ERRORS)=0

 W !!

 S DIC=778

 S DIC(0)="AEQM"

 S DIC("A")="SELECT FROM MESSAGE: "

 ;S DIC("W")="W $P(^(0),U,20)_""**""_$P($G(^HLA($P(^(0),U,2),0)),U,4)"

 S DIC("W")="W $P($G(^(0)),U,5)_""**""_$P($G(^HLA($P(^(0),U,2),0)),U,4)"

 S DIC("S")="I $P($G(^(0)),U,4)=""O"",($P($G(^(0)),U,20)'=""SU""),($P($G(^(0)),U,5)=""MPI"")"

 D ^DIC

 Q:Y<0

 S FRMSGIEN=+Y

TO ;EP - ASK TO

 S DIC=778

 S DIC(0)="AEQM"

 S DIC("A")="SELECT TO MESSAGE: "

 S DIC("B")=FRMSGIEN

 ;S DIC("W")="W $P(^(0),U,20)_""**""_$P($G(^HLA($P(^(0),U,2),0)),U,4)"

 S DIC("W")="W $P($G(^(0)),U,5)_""**""_$P($G(^HLA($P(^(0),U,2),0)),U,4)"

 S DIC("S")="I $P($G(^(0)),U,4)=""O"",($P($G(^(0)),U,20)'=""SU""),$P($G(^(0)),U,5)=""MPI"""

 D ^DIC

 Q:Y<0

 S TOMSGIEN=+Y

 I FRMSGIEN>TOMSGIEN D  G FROM

 .W !,"FROM MSG ID CAN NOT BE GREATER THAN THE TO MSG ID" H 2

 S MSGIEN=FRMSGIEN-.01

 F  S MSGIEN=$O(^HLB(MSGIEN)) Q:MSGIEN>TOMSGIEN  D

 .S LINK=$P($G(^HLB(MSGIEN,0)),U,5)

 .Q:LINK'="MPI"

 .S DIREC=$P($G(^HLB(MSGIEN,0)),U,4)

 .Q:DIREC'="O"

 .S COMSTAT=$P($G(^HLB(MSGIEN,0)),U,20)

 .Q:COMSTAT="SU"

 .;B "S+"

 .S EVENT=$P($P($G(^HLB(MSGIEN,2)),U,4),"~",2)

 .; 05/24/2013 - KJH - TFS8008 - Remove extraneous locks on the HLO globals.

 .S NEWIEN=$$RESEND^HLOAPI3(MSGIEN,.ERROR)

 .;B "S+"

 .D PARSE^AGMPIACK(.DATA,NEWIEN,.HLMSTATE)

 .S DFN=$G(DATA(2,4,3,1,1))

 .S GRDTOTAL=GRDTOTAL+1

 .I '$D(ERROR) D

 ..W !,"MESSAGE RESENT, NEW NUMBER: "_NEWIEN

 ..W !?17,"OLD NUMBER: ",MSGIEN

 ..D NOW^%DTC S Y=% X ^DD("DD") W !,"SENT AT ",Y

 ..S TOTEVENT(EVENT)=$G(TOTEVENT(EVENT))+1

 .E  D  Q

 ..S ERRORS(ERROR)=$G(ERRORS(ERROR))+1

 ;.05/29/2013 - KJH - TFS8109 - Since this is a 'resend', we do not need to kick off these protocols again.

 ;.IF NO ERROR KICK PROTOCOL OFF

 ;.I EVENT="A28" D  Q

 ;..S X="AG REGISTER A PATIENT",DIC=101,INDA=DFN

 ;..D EN^XQOR

 ;.I EVENT="A08" D

 ;..S X="AG UPDATE A PATIENT",DIC=101,INDA=DFN

 ;..D EN^XQOR

 W !!,"TOTAL MESSAGES PROCESSED: ",GRDTOTAL

 S ERROR=""

 F  S ERROR=$O(ERRORS(ERROR)) Q:ERROR=""  D

 .W !,ERRORS(ERROR)," ",ERROR

 S EVENT=""

 F  S EVENT=$O(TOTEVENT(EVENT)) Q:EVENT=""  D

 .W !,TOTEVENT(EVENT)," ",EVENT

 G RSAGAIN

 Q

 ;

CONDT(DATE) ;EP - CONVERT FM DATE INTO 2009-04-14 00:00:00

 N NEWDATE,TIME

 S TIME=$P(DATE,".",2)

 S DATE=$P(DATE,".")

 S TIME="."_$$FILLSTR^AGMPIHL1(TIME,6,"L",0)

 S DATE=DATE_TIME

 S NEWDATE=(1700+$E(DATE,1,3))

 S DATE=$TR(DATE,"."," ") S DATE=$E(DATE,4,14),NEWDATE=NEWDATE_DATE

 S NEWDATE=$E(NEWDATE,1,4)_"-"_$E(NEWDATE,5,6)_"-"_$E(NEWDATE,7,8)_" "_$E(NEWDATE,10,11)_":"_$E(NEWDATE,12,13)_":"_$E(NEWDATE,14,15)

 Q NEWDATE

 ;

DEMOPAT(DFN) ;EP - Check whether a patient is a demo patient and we are in a production environment.

 ; This is a demo patient if any one of the following criteria is true:

 ; a) TEST PATIENT INDICATOR (file 2, field 0.6) is set

 ; b) First five digits of the SSN are 0

 ; c) Patient's name matches 1"DEMO,PAT".E

 ; d) Patient's name matches 1"DEMO,GIMC".E

 Q:$G(DFN)="" 0

 Q:'$$PROD^XUPROD() 0  ; We only care about demo patients in production environments.

 N NODE,NAME

 S NODE=$G(^DPT(DFN,0))

 I $P(NODE,U,21) Q 1

 I $E($P(NODE,U,9),1,5)="00000" Q 1

 S NAME=$P(NODE,U)

 I NAME?1"DEMO,PAT".E Q 1

 I NAME?1"DEMO,GIMC".E Q 1

 Q 0

AGMPHLU   ; IHS/SD/TPF - MPI HLO MSG UTILITIES ; 12/15/2007

 +1       ;;7.2;IHS PATIENT REGISTRATION;**1,3,5,6**;MAY 20, 2010;Build 23

 +2        QUIT 

 +3       ;

DIRCON    ;EP - SEND A DIRECT CONNECT VQQ-Q02

 +1       ; 09/06/2017 - GCD - CR 7693 - Disabled VQQ messages because they are buggy and not needed.

 +2        WRITE !!,"THIS OPTION HAS BEEN DISABLED"

           QUIT 

 +3        WRITE !!,"ENTER PATIENT YOU WISH TO QUERY THE MPI FOR:"

 +4        WRITE !

 +5        DO PTLK^AG

 +6        IF '$DATA(DFN)

               QUIT 

 +7       ; 9/13/2017 - GCD - CR 7713 - Don't upload demo patients.

           IF $$DEMOPAT(DFN)

               WRITE !!,"Demo patients may not be uploaded to the MPI."

               GOTO DIRCON

 +8        DO CREATMSG^AGMPIHLO(DFN,"VTQ",,.SUCCESS)

 +9        IF SUCCESS

               Begin DoDot:1

 +10               WRITE !!,"Query message "_$GET(SUCCESS)_" has been sent to the MPI"

               End DoDot:1

               QUIT 

 +11       WRITE !,"Unable to query patient "_$PIECE(^DPT(DFN,0),U)_" on MPI"

 +12       QUIT 

 +13      ;

A28       ;EP - SEND A A28 ADD A PATIENT

 +1        WRITE !!,"ENTER PATIENT YOU WISH TO ADD TO THE MPI:"

 +2        DO PTLK^AG

 +3        IF '$DATA(DFN)

               QUIT 

 +4       ; 9/13/2017 - GCD - CR 7713 - Don't upload demo patients.

           IF $$DEMOPAT(DFN)

               WRITE !!,"Demo patients may not be uploaded to the MPI."

               GOTO A28

 +5        DO CREATMSG^AGMPIHLO(DFN,"A28",,.SUCCESS)

 +6        IF SUCCESS

               Begin DoDot:1

 +7                WRITE !!,"A28 Message "_SUCCESS_" has been sent to add patient "_$PIECE(^DPT(DFN,0),U)_" to the MPI."

                   HANG 2

 +8       ;05/29/2013 - KJH - TFS8109 - This was causing an extra message to be sent to EDR.

 +9       ;S X="AG REGISTER A PATIENT",DIC=101,INDA=DFN

 +10      ;D EN^XQOR

               End DoDot:1

               QUIT 

 +11       WRITE !,"Unable to create A28 to add patient "_$PIECE(^DPT(DFN,0),U)_" to MPI"

 +12       QUIT 

 +13      ;

A08       ;EP - SEND AN A08 UPDATE

 +1        WRITE !!,"EXAMPLE OF AN A08 UPDATE"

 +2        DO PTLK^AG

 +3        IF '$DATA(DFN)

               QUIT 

 +4       ; 9/13/2017 - GCD - CR 7713 - Don't upload demo patients.

           IF $$DEMOPAT(DFN)

               WRITE !!,"Demo patients may not be uploaded to the MPI."

               GOTO A08

 +5        DO CREATMSG^AGMPIHLO(DFN,"A08","",.SUCCESS)

 +6        IF SUCCESS

               Begin DoDot:1

 +7                WRITE !!,"A08 Message "_SUCCESS_" has been sent to update patient "_$PIECE(^DPT(DFN,0),U)_" on the MPI."

                   HANG 2

 +8       ;05/29/2013 - KJH - TFS8109 - This was causing an extra message to be sent to EDR.

 +9       ;S X="AG UPDATE A PATIENT",DIC=101,INDA=DFN

 +10      ;D EN^XQOR

               End DoDot:1

               QUIT 

 +11       WRITE !,"Unable to create A08 to update patient "_$PIECE(^DPT(DFN,0),U)_" on MPI"

 +12       QUIT 

 +13      ;

VISITMSG  ;EP - CREATE A NEW A01 OR A03

 +1        WRITE !!,"CREATE A VISIT HL7 MESSAGE"

 +2        DO PTLK^AG

 +3        IF '$DATA(DFN)

               QUIT 

 +4       ; 9/13/2017 - GCD - CR 7713 - Don't upload demo patients.

           IF $$DEMOPAT(DFN)

               WRITE !!,"Demo patients may not be uploaded to the MPI."

               GOTO VISITMSG

 +5        KILL DIR

 +6        SET DIR(0)="SO^A:ADMISSION;D:DISCHARGE;CIN:CHECK-IN;COUT:CHECK-OUT"

 +7        DO ^DIR

 +8        IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!(Y="")

               QUIT 

 +9       ;CHECK IN - CHECK OUT

 +10       IF Y="CIN"!(Y="COUT")

               Begin DoDot:1

 +11               SET EVENT=$SELECT(Y="CIN":4,1:5)

 +12               KILL DIR

 +13               SET DIR(0)="D^::RE"

 +14               SET DIR("A")="ENTER CHECK-"_$SELECT(Y="CIN":"IN",1:"OUT")_" DATE"

 +15               DO ^DIR

 +16               DO NOW^%DTC

                   SET NOW=%

 +17               IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!(Y="")

                       QUIT 

 +18               SET DATE=Y

 +19               DO CREATE^AGMPHL01(EVENT,DFN,DATE,.SUCCESS)

 +20               IF SUCCESS

                       Begin DoDot:2

 +21                       WRITE !!,$SELECT(EVENT=1:"A01",1:"A03")_" Message IEN "_SUCCESS_" has been sent to update patient"

 +22                       WRITE !,$PIECE(^DPT(DFN,0),U)_" last treated date on the MPI."

                           HANG 2

                       End DoDot:2

                       QUIT 

 +23               WRITE !,"Unable to create "_$SELECT(EVENT=1:"A01",1:"A03")_" to update patient "_$PIECE(^DPT(DFN,0),U)_" on MPI"

               End DoDot:1

               QUIT 

               IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!(Y="")

                   QUIT 

 +24      ;

 +25      ;ADMISSION - DISCHARGE

 +26       SET TYPE=$SELECT(Y="A":1,1:3)

 +27       KILL DIR

 +28       SET DIR(0)="D^::RE"

 +29       SET DIR("A")="ENTER MOVEMENT DATE"

 +30       DO ^DIR

 +31       DO NOW^%DTC

           SET NOW=%

 +32       IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!(Y="")

               QUIT 

 +33       SET DATETIME="T"_Y

 +34       DO CREATE^AGMPHL03(DFN,TYPE,DATETIME,.SUCCESS)

 +35       IF SUCCESS

               Begin DoDot:1

 +36               WRITE !!,$SELECT(TYPE=1:"A01",1:"A03")_" Message IEN "_SUCCESS_" has been sent to update patient"

 +37               WRITE !,$PIECE(^DPT(DFN,0),U)_" last treated date on the MPI."

                   HANG 2

               End DoDot:1

               QUIT 

 +38       WRITE !,"Unable to create "_$SELECT(TYPE=1:"A01",1:"A03")_" to update patient "_$PIECE(^DPT(DFN,0),U)_" on MPI"

 +39       QUIT 

 +40      ;

A40       ;EP - SEND A40 MERGE FROM/TO

 +1        NEW DFN1,DFN2,MRGDIR,NAME1,NAME2

PT1       ;ASK FOR FROM PATIENT

 +1       ; AG*7.2*5/CR 7718 - Overhauled this entire section because normal patient lookups don't work on merged patients.

 +2        WRITE !,"ENTER PATIENT TO KEEP:"

 +3        SET DIC="^VA(15,"

           SET DIC(0)="AEMQ"

           SET DIC("A")="Select PATIENT NAME: "

           DO ^DIC

 +4        IF Y=-1

               QUIT 

 +5        SET IEN=$PIECE(Y,"^")

 +6       ; 1=.01->.02, 2=.02->.01

           SET MRGDIR=$$GET1^DIQ(15,IEN_",",.04,"I")

 +7       ; From patient

           SET DFN1=$PIECE($$GET1^DIQ(15,IEN_",",$SELECT(MRGDIR=1:.01,1:.02),"I"),";")

 +8       ; To patient

           SET DFN2=$PIECE($$GET1^DIQ(15,IEN_",",$SELECT(MRGDIR=1:.02,1:.01),"I"),";")

 +9       ; 9/13/2017 - GCD - CR 7713 - Don't upload demo patients.

           IF $$DEMOPAT(DFN1)!$$DEMOPAT(DFN2)

               WRITE !!,"Demo patients may not be uploaded to the MPI."

               GOTO PT1

 +10      ; AG*7.2*5/CR 7718 - Corrected condition -- now checks that patient was merged into DFN2.

           IF $GET(^DPT(DFN1,-9))'=DFN2

               Begin DoDot:1

 +11               WRITE !,"THIS PATIENT HAS NOT BEEN MERGED TO FIRST PATIENT SUCCESSFULLY!"

 +12               KILL DIR

 +13               SET DIR(0)="E"

 +14               DO ^DIR

               End DoDot:1

               GOTO PT1

 +15      ; ^DIQ doesn't work on merged patients

           SET NAME1=$PIECE($GET(^DPT(DFN1,0)),U)

 +16       SET NAME2=$$GET1^DIQ(2,DFN2_",",.01,"I")

 +17       WRITE !

 +18       KILL DIR

 +19       SET DIR(0)="Y"

           SET DIR("A")="Send A40 for "_NAME1_" merged into "_NAME2

           SET DIR("B")="Yes"

 +20       DO ^DIR

 +21       IF Y="^"

               QUIT 

 +22       IF 'Y

               WRITE !

               GOTO PT1

 +23       DO CREATMSG^AGMPIHLO(DFN2,"A40",DFN1,.SUCCESS)

 +24       IF SUCCESS

               Begin DoDot:1

 +25               WRITE !!,"A40 Message "_SUCCESS_" has been sent to merge patient"

 +26               WRITE !,$PIECE(^DPT(DFN1,0),U)_" to patient "_$PIECE(^DPT(DFN2,0),U)

                   HANG 2

               End DoDot:1

               QUIT 

 +27       WRITE !,"Unable to merge "_$PIECE(^DPT(DFN1,0),U)_" to patient "_$PIECE(^DPT(DFN2,0),U)_" on MPI"

           HANG 2

 +28       QUIT 

 +29      ;

MFNMFK    ;EP - PROCESS MFN MESSAGE AND CREATE A MFK RESPONSE

 +1        KILL DIR,DIC,DA,DIE,DIR

 +2        WRITE !!

 +3        SET DIC(0)="AQEM"

 +4        SET DIC("S")="I $G(^HLB(Y,2))[""MFN"""

 +5        SET DIC="^HLB("

 +6        DO ^DIC

 +7        IF Y<0

               QUIT 

 +8        DO PROC^AGMPHMFN(+Y,.SUCCESS)

 +9        KILL DIR,DIC,DA,DIE,DIR

 +10       IF SUCCESS

               Begin DoDot:1

 +11               WRITE !!,"MFK Message "_SUCCESS_" has been sent to the MPI"

                   HANG 2

               End DoDot:1

               QUIT 

 +12       WRITE !,"Unable to create MFK message."

           HANG 2

 +13       QUIT 

 +14      ;

RESEND    ;EP - RESEND MESSAGE(S)

RSAGAIN   ;EP

 +1        NEW FRMSGIEN,TOMSGIEN,DIC,DT,NEWIEN,ERROR,Y

 +2        NEW MPIDIREC,TOTEVENT,GRDTOTAL,ERRORS

FROM      ;EP - ASK FROM

 +1        SET (MPIDIREC,TOTEVENT,GRDTOTAL,ERRORS)=0

 +2        WRITE !!

 +3        SET DIC=778

 +4        SET DIC(0)="AEQM"

 +5        SET DIC("A")="SELECT FROM MESSAGE: "

 +6       ;S DIC("W")="W $P(^(0),U,20)_""**""_$P($G(^HLA($P(^(0),U,2),0)),U,4)"

 +7        SET DIC("W")="W $P($G(^(0)),U,5)_""**""_$P($G(^HLA($P(^(0),U,2),0)),U,4)"

 +8        SET DIC("S")="I $P($G(^(0)),U,4)=""O"",($P($G(^(0)),U,20)'=""SU""),($P($G(^(0)),U,5)=""MPI"")"

 +9        DO ^DIC

 +10       IF Y<0

               QUIT 

 +11       SET FRMSGIEN=+Y

TO        ;EP - ASK TO

 +1        SET DIC=778

 +2        SET DIC(0)="AEQM"

 +3        SET DIC("A")="SELECT TO MESSAGE: "

 +4        SET DIC("B")=FRMSGIEN

 +5       ;S DIC("W")="W $P(^(0),U,20)_""**""_$P($G(^HLA($P(^(0),U,2),0)),U,4)"

 +6        SET DIC("W")="W $P($G(^(0)),U,5)_""**""_$P($G(^HLA($P(^(0),U,2),0)),U,4)"

 +7        SET DIC("S")="I $P($G(^(0)),U,4)=""O"",($P($G(^(0)),U,20)'=""SU""),$P($G(^(0)),U,5)=""MPI"""

 +8        DO ^DIC

 +9        IF Y<0

               QUIT 

 +10       SET TOMSGIEN=+Y

 +11       IF FRMSGIEN>TOMSGIEN

               Begin DoDot:1

 +12               WRITE !,"FROM MSG ID CAN NOT BE GREATER THAN THE TO MSG ID"

                   HANG 2

               End DoDot:1

               GOTO FROM

 +13       SET MSGIEN=FRMSGIEN-.01

 +14       FOR 

               SET MSGIEN=$ORDER(^HLB(MSGIEN))

               IF MSGIEN>TOMSGIEN

                   QUIT 

               Begin DoDot:1

 +15               SET LINK=$PIECE($GET(^HLB(MSGIEN,0)),U,5)

 +16               IF LINK'="MPI"

                       QUIT 

 +17               SET DIREC=$PIECE($GET(^HLB(MSGIEN,0)),U,4)

 +18               IF DIREC'="O"

                       QUIT 

 +19               SET COMSTAT=$PIECE($GET(^HLB(MSGIEN,0)),U,20)

 +20               IF COMSTAT="SU"

                       QUIT 

 +21      ;B "S+"

 +22               SET EVENT=$PIECE($PIECE($GET(^HLB(MSGIEN,2)),U,4),"~",2)

 +23      ; 05/24/2013 - KJH - TFS8008 - Remove extraneous locks on the HLO globals.

 +24               SET NEWIEN=$$RESEND^HLOAPI3(MSGIEN,.ERROR)

 +25      ;B "S+"

 +26               DO PARSE^AGMPIACK(.DATA,NEWIEN,.HLMSTATE)

 +27               SET DFN=$GET(DATA(2,4,3,1,1))

 +28               SET GRDTOTAL=GRDTOTAL+1

 +29               IF '$DATA(ERROR)

                       Begin DoDot:2

 +30                       WRITE !,"MESSAGE RESENT, NEW NUMBER: "_NEWIEN

 +31                       WRITE !?17,"OLD NUMBER: ",MSGIEN

 +32                       DO NOW^%DTC

                           SET Y=%

                           XECUTE ^DD("DD")

                           WRITE !,"SENT AT ",Y

 +33                       SET TOTEVENT(EVENT)=$GET(TOTEVENT(EVENT))+1

                       End DoDot:2

 +34              IF '$TEST

                       Begin DoDot:2

 +35                       SET ERRORS(ERROR)=$GET(ERRORS(ERROR))+1

                       End DoDot:2

                       QUIT 

               End DoDot:1

 +36      ;.05/29/2013 - KJH - TFS8109 - Since this is a 'resend', we do not need to kick off these protocols again.

 +37      ;.IF NO ERROR KICK PROTOCOL OFF

 +38      ;.I EVENT="A28" D  Q

 +39      ;..S X="AG REGISTER A PATIENT",DIC=101,INDA=DFN

 +40      ;..D EN^XQOR

 +41      ;.I EVENT="A08" D

 +42      ;..S X="AG UPDATE A PATIENT",DIC=101,INDA=DFN

 +43      ;..D EN^XQOR

 +44       WRITE !!,"TOTAL MESSAGES PROCESSED: ",GRDTOTAL

 +45       SET ERROR=""

 +46       FOR 

               SET ERROR=$ORDER(ERRORS(ERROR))

               IF ERROR=""

                   QUIT 

               Begin DoDot:1

 +47               WRITE !,ERRORS(ERROR)," ",ERROR

               End DoDot:1

 +48       SET EVENT=""

 +49       FOR 

               SET EVENT=$ORDER(TOTEVENT(EVENT))

               IF EVENT=""

                   QUIT 

               Begin DoDot:1

 +50               WRITE !,TOTEVENT(EVENT)," ",EVENT

               End DoDot:1

 +51       GOTO RSAGAIN

 +52       QUIT 

 +53      ;

CONDT(DATE) ;EP - CONVERT FM DATE INTO 2009-04-14 00:00:00

 +1        NEW NEWDATE,TIME

 +2        SET TIME=$PIECE(DATE,".",2)

 +3        SET DATE=$PIECE(DATE,".")

 +4        SET TIME="."_$$FILLSTR^AGMPIHL1(TIME,6,"L",0)

 +5        SET DATE=DATE_TIME

 +6        SET NEWDATE=(1700+$EXTRACT(DATE,1,3))

 +7        SET DATE=$TRANSLATE(DATE,"."," ")

           SET DATE=$EXTRACT(DATE,4,14)

           SET NEWDATE=NEWDATE_DATE

 +8        SET NEWDATE=$EXTRACT(NEWDATE,1,4)_"-"_$EXTRACT(NEWDATE,5,6)_"-"_$EXTRACT(NEWDATE,7,8)_" "_$EXTRACT(NEWDATE,10,11)_":"_$EXTRACT(NEWDATE,12,13)_":"_$EXTRACT(NEWDATE,14,15)

 +9        QUIT NEWDATE

 +10      ;

DEMOPAT(DFN) ;EP - Check whether a patient is a demo patient and we are in a production environment.

 +1       ; This is a demo patient if any one of the following criteria is true:

 +2       ; a) TEST PATIENT INDICATOR (file 2, field 0.6) is set

 +3       ; b) First five digits of the SSN are 0

 +4       ; c) Patient's name matches 1"DEMO,PAT".E

 +5       ; d) Patient's name matches 1"DEMO,GIMC".E

 +6        IF $GET(DFN)=""

               QUIT 0

 +7       ; We only care about demo patients in production environments.

           IF '$$PROD^XUPROD()

               QUIT 0

 +8        NEW NODE,NAME

 +9        SET NODE=$GET(^DPT(DFN,0))

 +10       IF $PIECE(NODE,U,21)

               QUIT 1

 +11       IF $EXTRACT($PIECE(NODE,U,9),1,5)="00000"

               QUIT 1

 +12       SET NAME=$PIECE(NODE,U)

 +13       IF NAME?1"DEMO,PAT".E

               QUIT 1

 +14       IF NAME?1"DEMO,GIMC".E

               QUIT 1

 +15       QUIT 0