AGMPIBGP.m

AGMPIBGP  ;IHS/SD/TPF - Patient Registration MPI INCOMING MESSAGE PROCESSOR

 ;;7.2;IHS PATIENT REGISTRATION;**1**;JAN 07, 2011

 ;BGP = BACKGROUND PROCESSOR

 Q

TSK ;EP - TASKMAN ENTRY POINT

 L +^AGMPIBGP:5 Q:'$T  ;DO NOT START IF ALREADY RUNNING

 N MSGDATE,MSGTYPE,MSGEVENT,MSGIEN

 S MSGDATE=""  ;DATE MSG PLACED IN HLB

 F  S MSGDATE=$O(^HLB("QUEUE","IN",MSGDATE)) Q:MSGDATE=""  D

 .S MSGTYPE=""

 .F  S MSGTYPE=$O(^HLB("QUEUE","IN",MSGDATE,"RPMS-MPI",MSGTYPE)) Q:MSGTYPE=""  D

 ..S MSGEVENT=""

 ..F  S MSGEVENT=$O(^HLB("QUEUE","IN",MSGDATE,"RPMS-MPI",MSGTYPE,MSGEVENT)) Q:MSGEVENT=""  D

 ...S MSGIEN=""

 ...F  S MSGIEN=$O(^HLB("QUEUE","IN",MSGDATE,"RPMS-MPI",MSGTYPE,MSGEVENT,MSGIEN)) Q:MSGIEN=""  D

 ....;^HLB(4,2)=^20100429083020.78-0700^^ACK~A08^134^T^2.4^^^NE^NE

 ....;ACCEPT TYPE ACKNOWLEDGEMENT

 ....S ACCTYACK=$P($G(^HLB(MSGIEN,2)),U,10)

 ....I ACCTYACK="NE" D MSGCMPLT(MSGIEN) D KILL Q  ;NO NEED TO PROCESS

 ....I ACCTYACK="" D  Q

 .....S ERROR="NO ENTRY FOR THIS MSG IN THE 'IN QUEUE' KILLING X-REF"

 .....D MSGERR("","",MSGIEN,ERROR)

 .....D KILL

 ....I MSGEVENT="A08" D PROC^AGMPIACK(MSGIEN) D KILL Q

 ....I MSGEVENT="A28" D PROC^AGMPIACK(MSGIEN) D KILL Q

 ....I MSGEVENT="Q02" D PROC^AGMPHLVQ(MSGIEN) D KILL Q

 ....I MSGEVENT="M05" D PROC^AGMPHMFN(MSGIEN) D KILL Q

 ....I MSGEVENT="A01" D PROC^AGMPHL01(MSGIEN) D KILL Q

 ....I MSGEVENT="A03" D PROC^AGMPHL03(MSGIEN) D KILL Q

 ....; REMAINING MESSAGE TYPES ENCOUNTERED NOT PROCESSED

 ....S ERROR="ENTRY FOR MESSAGE EVENT '"_MSGEVENT_"' NOT BEING PROCESSED."

 ....D MSGERR("","",MSGIEN,ERROR)

 ....D MSGCMPLT(MSGIEN)

 ....D KILL Q

 L -^AGMPIBGP  ;CLEAR RUNNING FLAG

 Q

KILL ;EP - CLEAR QUE

 K ^HLB("QUEUE","IN",MSGDATE,"RPMS-MPI",MSGTYPE,MSGEVENT,MSGIEN)

 Q

 ;

MSGERR(LOCALID,ACKIEN,HLMSGIEN,ERROR) ;EP - PROCESS ERROR ALERT

 S AGERROR="MSG IEN: "_HLMSGIEN_" :: "_ERROR

 D NOTIF^AGMPIHLO("",AGERROR)

 Q

 ;

MSGCMPLT(MSGID) ;EP - MARK MESSAGE SUCCESSFULLY COMPLETED. SET PURGE INFORMATION

 I MSGID="" Q

 N PDT,NODE

 S NODE=$G(^HLB(MSGID,0))

 I NODE="" Q

 ;IF A PURGE DATE ALREADY EXISTS, KILL THE OLD "AD" ENTRY TO MAINTAIN THE CROSS-REFERENCE'S INTEGRITY

 S PDT=$P(NODE,U,9)

 I PDT'="" K ^HLB("AD","OUT",PDT,MSGID)

 ;SET PURGE DATE TO SEVEN DAYS FROM NOW

 S X="N+7D",%DT="R" D ^%DT S PDT=Y

 S $P(NODE,U,9)=PDT

 ;SET STATUS TO SUCCESS

 S $P(NODE,U,20)="SU"

 S ^HLB(MSGID,0)=NODE

 I PDT]"" S ^HLB("AD","OUT",PDT,MSGID)=""

 Q

AGMPIBGP  ;IHS/SD/TPF - Patient Registration MPI INCOMING MESSAGE PROCESSOR

 +1       ;;7.2;IHS PATIENT REGISTRATION;**1**;JAN 07, 2011

 +2       ;BGP = BACKGROUND PROCESSOR

 +3        QUIT 

TSK       ;EP - TASKMAN ENTRY POINT

 +1       ;DO NOT START IF ALREADY RUNNING

           LOCK +^AGMPIBGP:5

           IF '$TEST

               QUIT 

 +2        NEW MSGDATE,MSGTYPE,MSGEVENT,MSGIEN

 +3       ;DATE MSG PLACED IN HLB

           SET MSGDATE=""

 +4        FOR 

               SET MSGDATE=$ORDER(^HLB("QUEUE","IN",MSGDATE))

               IF MSGDATE=""

                   QUIT 

               Begin DoDot:1

 +5                SET MSGTYPE=""

 +6                FOR 

                       SET MSGTYPE=$ORDER(^HLB("QUEUE","IN",MSGDATE,"RPMS-MPI",MSGTYPE))

                       IF MSGTYPE=""

                           QUIT 

                       Begin DoDot:2

 +7                        SET MSGEVENT=""

 +8                        FOR 

                               SET MSGEVENT=$ORDER(^HLB("QUEUE","IN",MSGDATE,"RPMS-MPI",MSGTYPE,MSGEVENT))

                               IF MSGEVENT=""

                                   QUIT 

                               Begin DoDot:3

 +9                                SET MSGIEN=""

 +10                               FOR 

                                       SET MSGIEN=$ORDER(^HLB("QUEUE","IN",MSGDATE,"RPMS-MPI",MSGTYPE,MSGEVENT,MSGIEN))

                                       IF MSGIEN=""

                                           QUIT 

                                       Begin DoDot:4

 +11      ;^HLB(4,2)=^20100429083020.78-0700^^ACK~A08^134^T^2.4^^^NE^NE

 +12      ;ACCEPT TYPE ACKNOWLEDGEMENT

 +13                                       SET ACCTYACK=$PIECE($GET(^HLB(MSGIEN,2)),U,10)

 +14      ;NO NEED TO PROCESS

                                           IF ACCTYACK="NE"

                                               DO MSGCMPLT(MSGIEN)

                                               DO KILL

                                               QUIT 

 +15                                       IF ACCTYACK=""

                                               Begin DoDot:5

 +16                                               SET ERROR="NO ENTRY FOR THIS MSG IN THE 'IN QUEUE' KILLING X-REF"

 +17                                               DO MSGERR("","",MSGIEN,ERROR)

 +18                                               DO KILL

                                               End DoDot:5

                                               QUIT 

 +19                                       IF MSGEVENT="A08"

                                               DO PROC^AGMPIACK(MSGIEN)

                                               DO KILL

                                               QUIT 

 +20                                       IF MSGEVENT="A28"

                                               DO PROC^AGMPIACK(MSGIEN)

                                               DO KILL

                                               QUIT 

 +21                                       IF MSGEVENT="Q02"

                                               DO PROC^AGMPHLVQ(MSGIEN)

                                               DO KILL

                                               QUIT 

 +22                                       IF MSGEVENT="M05"

                                               DO PROC^AGMPHMFN(MSGIEN)

                                               DO KILL

                                               QUIT 

 +23                                       IF MSGEVENT="A01"

                                               DO PROC^AGMPHL01(MSGIEN)

                                               DO KILL

                                               QUIT 

 +24                                       IF MSGEVENT="A03"

                                               DO PROC^AGMPHL03(MSGIEN)

                                               DO KILL

                                               QUIT 

 +25      ; REMAINING MESSAGE TYPES ENCOUNTERED NOT PROCESSED

 +26                                       SET ERROR="ENTRY FOR MESSAGE EVENT '"_MSGEVENT_"' NOT BEING PROCESSED."

 +27                                       DO MSGERR("","",MSGIEN,ERROR)

 +28                                       DO MSGCMPLT(MSGIEN)

 +29                                       DO KILL

                                           QUIT 

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +30      ;CLEAR RUNNING FLAG

           LOCK -^AGMPIBGP

 +31       QUIT 

KILL      ;EP - CLEAR QUE

 +1        KILL ^HLB("QUEUE","IN",MSGDATE,"RPMS-MPI",MSGTYPE,MSGEVENT,MSGIEN)

 +2        QUIT 

 +3       ;

MSGERR(LOCALID,ACKIEN,HLMSGIEN,ERROR) ;EP - PROCESS ERROR ALERT

 +1        SET AGERROR="MSG IEN: "_HLMSGIEN_" :: "_ERROR

 +2        DO NOTIF^AGMPIHLO("",AGERROR)

 +3        QUIT 

 +4       ;

MSGCMPLT(MSGID) ;EP - MARK MESSAGE SUCCESSFULLY COMPLETED. SET PURGE INFORMATION

 +1        IF MSGID=""

               QUIT 

 +2        NEW PDT,NODE

 +3        SET NODE=$GET(^HLB(MSGID,0))

 +4        IF NODE=""

               QUIT 

 +5       ;IF A PURGE DATE ALREADY EXISTS, KILL THE OLD "AD" ENTRY TO MAINTAIN THE CROSS-REFERENCE'S INTEGRITY

 +6        SET PDT=$PIECE(NODE,U,9)

 +7        IF PDT'=""

               KILL ^HLB("AD","OUT",PDT,MSGID)

 +8       ;SET PURGE DATE TO SEVEN DAYS FROM NOW

 +9        SET X="N+7D"

           SET %DT="R"

           DO ^%DT

           SET PDT=Y

 +10       SET $PIECE(NODE,U,9)=PDT

 +11      ;SET STATUS TO SUCCESS

 +12       SET $PIECE(NODE,U,20)="SU"

 +13       SET ^HLB(MSGID,0)=NODE

 +14       IF PDT]""

               SET ^HLB("AD","OUT",PDT,MSGID)=""

 +15       QUIT