- 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
