Routine: AGMPHLVQ

AGMPHLVQ ; IHS/SD/TPF - MPI VQQ-Q02 ACK PROCESSOR FOR HLO ; 12/15/2007

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

PROC(HLMSGIEN) ;EP - CALLED FROM AGMPIBGP

 ; 9/07/2017 - GCD - CR 7693 - Disabled VQQ processing. Mark the message complete so it will purge.

 D MSGCMPLT^AGMPIBGP(HLMSGIEN)

 N DATA,HLMSTATE,MSGID,MSGSEG,ICNEUID

 D PARSE(.DATA,HLMSGIEN,.HLMSTATE)

 S DFN=DATA(3,4,3,1,1)

 S ACKIEN=HLMSGIEN

 ;05/29/2013 - KJH - TFS8067 - Removed 'RESEND' checks which were looking at the ^HLA global using the IEN for the ^HLB global.

 S HLMSGIEN=$P($G(^HLB(HLMSGIEN,0)),U,2)

 ;WE NEED TO SEND AN A28 NO MATTER WHAT THE REPSONSE IS TO TRIGGER

 ;THE MFN BEING SENT OUT TO LINKED FACILTIES

 ;I $G(DATA(2,3,1,1,1))="NF" D  Q  ;EXACT MATCH NOT FOUND FOR PATIENT SO REQUEST ADD TO MPI

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

 I 'SUCCESS D NOTIF^AGMPIHLO(DFN,"Unable to create A28 to add patient to MPI from AGMPHLVQ") Q

 D MSGCMPLT^AGMPIBGP(ACKIEN)

 D MSGCMPLT^AGMPIBGP(HLMSGIEN)

 ;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

 ;END IF

 S ICNEUID=$G(DATA(3,4,1,1,1))   ;ICN (VA MPI) OR EUID (SUN MPI)

 I ICNEUID="" D NOTIF^AGMPIHLO(DFN,"ICNEUID PULLED FROM DATA(3,4,1,1,1) WAS EMPTY. NOT CALLING ADDICN") Q

 D ADDICN(ICNEUID,DFN)

PARSE(DATA,MIEN,HLMSTATE) ;EP

 N SEG,CNT

 Q:'$$STARTMSG^HLOPRS(.HLMSTATE,MIEN)

 M DATA("HDR")=HLMSTATE("HDR")

 S CNT=0

 F  Q:'$$NEXTSEG^HLOPRS(.HLMSTATE,.SEG)  D

 .S CNT=CNT+1

 .M DATA(CNT)=SEG

PROCFAC(ASSOCFAC) ;EP - ADD MPI LINKED FACILTIES TO 'TREATING FACILITY LIST' FILE

 K DIC,DIE,DR,DIR,DA,PTDFN,FAC,SYSCODE,LOCID

 S LOCDFN=DFN

 S DIC(0)="L"

 S DIC="^DGCN(391.91,"

 S X=LOCDFN

 S DIC(0)="LQZ"

 F FAC=1:1 S SYSLOCID=$P(ASSOCFAC,"|",FAC) Q:'SYSLOCID  D

 .S SYSCODE=$P(SYSLOCID,"~")  ;SYSTEM CODE (SUN MPI) OR STATION NUMBER (RPMS & VA) (ORIGINAL DEVELOPMENT USED UNIQUE DB ID)

 .S LOCID=$P(SYSLOCID,"~",2)  ;LOCAL ID (SUN MPI) OR DFN (RPMS & VA)

 .S TFAC=$O(^DIC(4,"D",SYSCODE,""))  ;TREATING FAC PTR

 .S DIC("DR")=".02///`"_TFAC

 .S DIC("DR")=DIC("DR")_";9999999.01////^S X=LOCID"

 .K DD,DO

 .D FILE^DICN

 .Q:Y<0

ADDICN(AGICN,DFN) ;EP - ADD TO 'INTEGRATED CONTROL NUMBER' FIELD

 K DIE,DIC,DA,DR,DIR

 S DIE="^DPT("

 S DA=DFN

 S RGRSICN=1

 S DR="991.01///^S X=AGICN"

 D ^DIE

 ;ERROR LOG??

MSGERR(LOCALID,HLMTIEN,ERRIEN) ;EP - EROR OCURRED IN VQQ ACK

 D NOW^%DTC

 S AGERROR="LOCALID: "_LOCALID_" -1^SUN MPI ACK RETURN ERR"

 ;06/04/2013 - DMB - Routine does not exist.  Removing call.

 ;    MSGERR does not seem to be called so no functionality seems to be removed

 ;D MAIL^AGMPILD(AGERROR,%,"VQQ",HLMTIEN,ERRIEN)  ;SEND ERROR MAIL MESSAGE

AGMPHLVQ  ; IHS/SD/TPF - MPI VQQ-Q02 ACK PROCESSOR FOR HLO ; 12/15/2007

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

 +2        QUIT

PROC(HLMSGIEN) ;EP - CALLED FROM AGMPIBGP

 +1       ; 9/07/2017 - GCD - CR 7693 - Disabled VQQ processing. Mark the message complete so it will purge.

 +2        DO MSGCMPLT^AGMPIBGP(HLMSGIEN)

 +3        QUIT

 +4       ;

 +5        NEW DATA,HLMSTATE,MSGID,MSGSEG,ICNEUID

 +6        DO PARSE(.DATA,HLMSGIEN,.HLMSTATE)

 +7        SET DFN=DATA(3,4,3,1,1)

 +8        SET ACKIEN=HLMSGIEN

 +9       ;05/29/2013 - KJH - TFS8067 - Removed 'RESEND' checks which were looking at the ^HLA global using the IEN for the ^HLB global.

 +10       SET HLMSGIEN=$PIECE($GET(^HLB(HLMSGIEN,0)),U,2)

 +11      ;WE NEED TO SEND AN A28 NO MATTER WHAT THE REPSONSE IS TO TRIGGER

 +12      ;THE MFN BEING SENT OUT TO LINKED FACILTIES

 +13      ;I $G(DATA(2,3,1,1,1))="NF" D  Q  ;EXACT MATCH NOT FOUND FOR PATIENT SO REQUEST ADD TO MPI

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

 +15       IF 'SUCCESS

               DO NOTIF^AGMPIHLO(DFN,"Unable to create A28 to add patient to MPI from AGMPHLVQ")

               QUIT

 +16       DO MSGCMPLT^AGMPIBGP(ACKIEN)

 +17       DO MSGCMPLT^AGMPIBGP(HLMSGIEN)

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

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

 +20      ;D EN^XQOR

 +21      ;END IF

 +22      ;ICN (VA MPI) OR EUID (SUN MPI)

           SET ICNEUID=$GET(DATA(3,4,1,1,1))

 +23       IF ICNEUID=""

               DO NOTIF^AGMPIHLO(DFN,"ICNEUID PULLED FROM DATA(3,4,1,1,1) WAS EMPTY. NOT CALLING ADDICN")

               QUIT

 +24       DO ADDICN(ICNEUID,DFN)

 +25       QUIT

 +26      ;

PARSE(DATA,MIEN,HLMSTATE) ;EP

 +1        NEW SEG,CNT

 +2        IF '$$STARTMSG^HLOPRS(.HLMSTATE,MIEN)

               QUIT

 +3        MERGE DATA("HDR")=HLMSTATE("HDR")

 +4        SET CNT=0

 +5        FOR

               IF '$$NEXTSEG^HLOPRS(.HLMSTATE,.SEG)

                   QUIT

               Begin DoDot:1

 +6                SET CNT=CNT+1

 +7                MERGE DATA(CNT)=SEG

               End DoDot:1

 +8        QUIT

 +9       ;

PROCFAC(ASSOCFAC) ;EP - ADD MPI LINKED FACILTIES TO 'TREATING FACILITY LIST' FILE

 +1        KILL DIC,DIE,DR,DIR,DA,PTDFN,FAC,SYSCODE,LOCID

 +2        SET LOCDFN=DFN

 +3        SET DIC(0)="L"

 +4        SET DIC="^DGCN(391.91,"

 +5        SET X=LOCDFN

 +6        SET DIC(0)="LQZ"

 +7        FOR FAC=1:1

               SET SYSLOCID=$PIECE(ASSOCFAC,"|",FAC)

               IF 'SYSLOCID

                   QUIT

               Begin DoDot:1

 +8       ;SYSTEM CODE (SUN MPI) OR STATION NUMBER (RPMS & VA) (ORIGINAL DEVELOPMENT USED UNIQUE DB ID)

                   SET SYSCODE=$PIECE(SYSLOCID,"~")

 +9       ;LOCAL ID (SUN MPI) OR DFN (RPMS & VA)

                   SET LOCID=$PIECE(SYSLOCID,"~",2)

 +10      ;TREATING FAC PTR

                   SET TFAC=$ORDER(^DIC(4,"D",SYSCODE,""))

 +11               SET DIC("DR")=".02///`"_TFAC

 +12               SET DIC("DR")=DIC("DR")_";9999999.01////^S X=LOCID"

 +13               KILL DD,DO

 +14               DO FILE^DICN

 +15               IF Y<0

                       QUIT

               End DoDot:1

 +16       QUIT

 +17      ;

ADDICN(AGICN,DFN) ;EP - ADD TO 'INTEGRATED CONTROL NUMBER' FIELD

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

 +2        SET DIE="^DPT("

 +3        SET DA=DFN

 +4        SET RGRSICN=1

 +5        SET DR="991.01///^S X=AGICN"

 +6        DO ^DIE

 +7       ;ERROR LOG??

 +8        QUIT

 +9       ;

MSGERR(LOCALID,HLMTIEN,ERRIEN) ;EP - EROR OCURRED IN VQQ ACK

 +1        DO NOW^%DTC

 +2        SET AGERROR="LOCALID: "_LOCALID_" -1^SUN MPI ACK RETURN ERR"

 +3       ;06/04/2013 - DMB - Routine does not exist.  Removing call.

 +4       ;    MSGERR does not seem to be called so no functionality seems to be removed

 +5       ;D MAIL^AGMPILD(AGERROR,%,"VQQ",HLMTIEN,ERRIEN)  ;SEND ERROR MAIL MESSAGE

 +6        QUIT

AGMPHLVQ.m