AGMPHL03 ; IHS/SD/TPF - MPI ADT-A03 ACK PROCESSOR FOR HLO ; 12/15/2007
;;7.2;IHS PATIENT REGISTRATION;**1,6**;JAN 07, 2011;Build 23
Q
;
PROC(HLMSGIEN) ;EP - CALLED FROM AGMPIBGP
N DATA,HLMSTATE,MSGID,MSGSEG,ICNEUID,RETCODE,NEXTSEG,RESEND,ORGHLMSG
D PARSE(.DATA,HLMSGIEN,.HLMSTATE)
D MSGCMPLT^AGMPIBGP(HLMSGIEN) ;SET THE ACK SUCCESSFUL
;NOW DO THE ORIGINATING MESSAGE
S ORGHLMSG=HLMSGIEN ;PRESERVE HLMSGIEN THAT WAS PASSED
S HLMSGIEN=$P($G(DATA(1,3,1,1,1))," ",2) ;MSG ID OF THE MSG THIS ACK IS RESPONDING TO
I HLMSGIEN="" D Q
.S ERROR="NO ORIGINATING MSG ID FOUND FOR HLMSGIEN '"_ORGHLMSG_"'"
.D NOTIF^AGMPIHLO(ORGHLMSG,ERROR)
S HLMSGIEN=$P($G(^HLB(HLMSGIEN,0)),U,2) ;GET THE CORRECT ORIGINATING MESSAGE
D MSGCMPLT^AGMPIBGP(HLMSGIEN)
Q
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
Q
;
;THIS CALL HANDLES ADMISSIONS (A01) AND DISCHARGES (A03)
CREATE(DFN,DGPMT,DGPMCA,SUCCESS) ;EP - CREATE AND PLACE IN OUTGOING QUEUE
;CALLED BY PROTOCOL 'AGMP MPI ADMIT DISCHARG' WHICH SUBSCRIBES
;TO PROTOCOL 'BSDAM MOVEMENT EVENTS' FOR ADMISSIONS AND DISCHARGES
;DFN
;DGPMT = TYPE OF MOVEMENT
; 1 = ADMISSION
; 2 = WARD TRANSFER
; 3 = DISCHARGE
; 4 = CHECK-IN LODGER
; 5 = CHECK-OUT LODGER
; 6 = SERVICE TRANSFER
;
;DGPMDA = MOVEMENTS IFN
;DGPMCA = ADMISSION IFN
;
Q:(U_1_U_3_U)'[(U_DGPMT_U)
;
I $$DEMOPAT^AGMPHLU($G(DFN)) Q ; 9/13/2017 - GCD - CR 7713 - Don't upload demo patients.
;
;GET DATE OF ADMISSION OR DISCHARGE
;
I $E(DGPMCA)="T" S SDT=$TR(DGPMCA,"T") ;CALL CAME FROM AGMPHLU
E S SDT=$$GET1^DIQ(405,+DGPMCA_",",.01,"I")
;
S SDT=$$CONDT^AGMPHLU(SDT) ;CONVERT DATE FOR MPI
I DGPMT=1 D CREATMSG^AGMPIHLO(DFN,"A01",,.SUCCESS)
E D CREATMSG^AGMPIHLO(DFN,"A03",,.SUCCESS)
I 'SUCCESS D
.S AGERROR="MPI DFN="_DFN_" :: "_"ERROR WHEN CREATING "_$S(DGPMT=1:"A01",1:"A03")
.D NOTIF^AGMPIHLO(DFN,AGERROR)
Q
AGMPHL03 ; IHS/SD/TPF - MPI ADT-A03 ACK PROCESSOR FOR HLO ; 12/15/2007
+1 ;;7.2;IHS PATIENT REGISTRATION;**1,6**;JAN 07, 2011;Build 23
+2 QUIT
+3 ;
PROC(HLMSGIEN) ;EP - CALLED FROM AGMPIBGP
+1 NEW DATA,HLMSTATE,MSGID,MSGSEG,ICNEUID,RETCODE,NEXTSEG,RESEND,ORGHLMSG
+2 DO PARSE(.DATA,HLMSGIEN,.HLMSTATE)
+3 ;SET THE ACK SUCCESSFUL
DO MSGCMPLT^AGMPIBGP(HLMSGIEN)
+4 ;NOW DO THE ORIGINATING MESSAGE
+5 ;PRESERVE HLMSGIEN THAT WAS PASSED
SET ORGHLMSG=HLMSGIEN
+6 ;MSG ID OF THE MSG THIS ACK IS RESPONDING TO
SET HLMSGIEN=$PIECE($GET(DATA(1,3,1,1,1))," ",2)
+7 IF HLMSGIEN=""
Begin DoDot:1
+8 SET ERROR="NO ORIGINATING MSG ID FOUND FOR HLMSGIEN '"_ORGHLMSG_"'"
+9 DO NOTIF^AGMPIHLO(ORGHLMSG,ERROR)
End DoDot:1
QUIT
+10 ;GET THE CORRECT ORIGINATING MESSAGE
SET HLMSGIEN=$PIECE($GET(^HLB(HLMSGIEN,0)),U,2)
+11 DO MSGCMPLT^AGMPIBGP(HLMSGIEN)
+12 QUIT
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 ;
+10 ;THIS CALL HANDLES ADMISSIONS (A01) AND DISCHARGES (A03)
CREATE(DFN,DGPMT,DGPMCA,SUCCESS) ;EP - CREATE AND PLACE IN OUTGOING QUEUE
+1 ;CALLED BY PROTOCOL 'AGMP MPI ADMIT DISCHARG' WHICH SUBSCRIBES
+2 ;TO PROTOCOL 'BSDAM MOVEMENT EVENTS' FOR ADMISSIONS AND DISCHARGES
+3 ;DFN
+4 ;DGPMT = TYPE OF MOVEMENT
+5 ; 1 = ADMISSION
+6 ; 2 = WARD TRANSFER
+7 ; 3 = DISCHARGE
+8 ; 4 = CHECK-IN LODGER
+9 ; 5 = CHECK-OUT LODGER
+10 ; 6 = SERVICE TRANSFER
+11 ;
+12 ;DGPMDA = MOVEMENTS IFN
+13 ;DGPMCA = ADMISSION IFN
+14 ;
+15 IF (U_1_U_3_U)'[(U_DGPMT_U)
QUIT
+16 ;
+17 ; 9/13/2017 - GCD - CR 7713 - Don't upload demo patients.
IF $$DEMOPAT^AGMPHLU($GET(DFN))
QUIT
+18 ;
+19 ;GET DATE OF ADMISSION OR DISCHARGE
+20 ;
+21 ;CALL CAME FROM AGMPHLU
IF $EXTRACT(DGPMCA)="T"
SET SDT=$TRANSLATE(DGPMCA,"T")
+22 IF '$TEST
SET SDT=$$GET1^DIQ(405,+DGPMCA_",",.01,"I")
+23 ;
+24 ;CONVERT DATE FOR MPI
SET SDT=$$CONDT^AGMPHLU(SDT)
+25 IF DGPMT=1
DO CREATMSG^AGMPIHLO(DFN,"A01",,.SUCCESS)
+26 IF '$TEST
DO CREATMSG^AGMPIHLO(DFN,"A03",,.SUCCESS)
+27 IF 'SUCCESS
Begin DoDot:1
+28 SET AGERROR="MPI DFN="_DFN_" :: "_"ERROR WHEN CREATING "_$SELECT(DGPMT=1:"A01",1:"A03")
+29 DO NOTIF^AGMPIHLO(DFN,AGERROR)
End DoDot:1
+30 QUIT