[613] | 1 | SCMCHLRR ;BP/DJB - PCMM HL7 Rejects - Resubmit ; 3/6/00 12:14pm
|
---|
| 2 | ;;5.3;Scheduling;**210,224,272**;AUG 13, 1993
|
---|
| 3 | ;
|
---|
| 4 | EN(SCLIM) ;Entry point for retransmitting "M"arked messages
|
---|
| 5 | ;
|
---|
| 6 | ;Input:
|
---|
| 7 | ; SCLIM - maximum messages allowed per batch passed by reference
|
---|
| 8 | ;
|
---|
| 9 | ;Output: none
|
---|
| 10 | ;
|
---|
| 11 | Q:'$D(SCLIM)
|
---|
| 12 | ;
|
---|
| 13 | NEW DFN,SCDELETE,VARPTR
|
---|
| 14 | NEW MSGCNT,SCFAC,SCSEQ
|
---|
| 15 | ;
|
---|
| 16 | ;Send notification msg if new HL7 reject transmissions received
|
---|
| 17 | D NOTIFY^SCMCHLM
|
---|
| 18 | ;
|
---|
| 19 | ;Initialize variables needed by GENERATE^SCMCHLG
|
---|
| 20 | S SCFAC=+$P($$SITE^VASITE(),"^",3) ;..Facility number
|
---|
| 21 | S MSGCNT=0 ;..........................Message count
|
---|
| 22 | ;
|
---|
| 23 | ;Loop thru PCMM HL7 TRANSMISSION LOG and resubmit items
|
---|
| 24 | D LOOP
|
---|
| 25 | ;
|
---|
| 26 | EXIT ;
|
---|
| 27 | Q
|
---|
| 28 | ;
|
---|
| 29 | ;
|
---|
| 30 | LOOP ;Loop thru PCMM HL7 TRANSMISSION LOG file and find every entry
|
---|
| 31 | ;with STATUS="M", and re-transmit.
|
---|
| 32 | ;
|
---|
| 33 | NEW TRANI
|
---|
| 34 | S TRANI=0
|
---|
| 35 | F S TRANI=$O(^SCPT(404.471,"ASTAT","M",TRANI)) Q:'TRANI!(SCLIM<1) D
|
---|
| 36 | . N WORK S (WORK,VARPTR)=$P($G(^SCPT(404.471,+TRANI,0)),U,7)
|
---|
| 37 | . I '$G(WORK) D GETDATA(TRANI) ;..Get DFN,VARPTR,SCDELETE
|
---|
| 38 | . ;alb/rpm - Missing ZPC segment messages will not retransmit.
|
---|
| 39 | . ; Clear the entry by setting status to "RT".
|
---|
| 40 | . I VARPTR="" D STATUS(TRANI,"RT") Q
|
---|
| 41 | . D RETRAN ;.......................Re-transmit message
|
---|
| 42 | Q
|
---|
| 43 | GETDATA(TRANI) ;Get DFN & VARPTR from PCMM HL7 TRANSMISSION LOG file
|
---|
| 44 | ; Input:
|
---|
| 45 | ; TRANI - IEN to file PCMM HL7 TRANSMISSION LOG file (#404.471)
|
---|
| 46 | ;Output:
|
---|
| 47 | ; DFN - Patient IEN
|
---|
| 48 | ; VARPTR - Variable pointer to 404.43 (ex: "2404;SCPT(404.43,")
|
---|
| 49 | ; SCDELETE - Flag to process a delete
|
---|
| 50 | ;
|
---|
| 51 | NEW IDI,IDLONG,ND,PTPI
|
---|
| 52 | ;
|
---|
| 53 | ;Initialize return variables
|
---|
| 54 | S (DFN,VARPTR)=""
|
---|
| 55 | S SCDELETE=0
|
---|
| 56 | ;
|
---|
| 57 | S IDI=$O(^SCPT(404.471,TRANI,"ZPC","C",0)) Q:'IDI
|
---|
| 58 | S ND=$G(^SCPT(404.49,IDI,0)) ;............PCMM HL7 ID zero node
|
---|
| 59 | S IDLONG=$P(ND,U,1) ;.....................Get long form of ID
|
---|
| 60 | ;alb/rpm;Patch 224;Fix DFN retrieval to prevent missing PID/EVN segments
|
---|
| 61 | S DFN=$P($G(^SCPT(404.471,TRANI,0)),U,2) Q:'DFN
|
---|
| 62 | S PTPI=$P(IDLONG,"-",1) ;.................File 404.43 IEN
|
---|
| 63 | Q:'PTPI
|
---|
| 64 | I '$D(^SCPT(404.43,PTPI)) S SCDELETE=1 ;..Flag to process a delete
|
---|
| 65 | S VARPTR=PTPI_";SCPT(404.43," ;...........Create event pointer
|
---|
| 66 | Q
|
---|
| 67 | ;
|
---|
| 68 | RETRAN ;Re-transmit messages.
|
---|
| 69 | ;
|
---|
| 70 | NEW PT,PTPI,RESULT,XMITARRY
|
---|
| 71 | NEW HL,HLECH,HLEID,HLFS,HLQ
|
---|
| 72 | ;
|
---|
| 73 | ;Initialize array
|
---|
| 74 | S XMITARRY="^TMP(""PCMM"",""HL7"","_$J_")" ;..Segments
|
---|
| 75 | KILL @XMITARRY
|
---|
| 76 | ;
|
---|
| 77 | ;Get pointer to sending event
|
---|
| 78 | S HLEID=$$HLEID^SCMCHL()
|
---|
| 79 | I 'HLEID D Q
|
---|
| 80 | . Q:$D(ZTQUEUED)
|
---|
| 81 | . W "Unable to initialize HL7 variables - protocol not found"
|
---|
| 82 | ;
|
---|
| 83 | ;Initialize HL7 variables
|
---|
| 84 | D INIT^HLFNC2(HLEID,.HL)
|
---|
| 85 | I $G(WORK) S RESULT=$$BUILD^SCMCHLP(VARPTR,.HL,.XMITARRY,$G(TRANI)) D GEN Q
|
---|
| 86 | I $O(HL(""))="" W:'$D(ZTQUEUED) $P(HL,"^",2) Q
|
---|
| 87 | ;
|
---|
| 88 | ;Build segment array
|
---|
| 89 | I $G(SCDELETE) D I 1 ;....................Process a deletion
|
---|
| 90 | . S PTPI=$P(VARPTR,";",1)
|
---|
| 91 | . D PTPD^SCMCHLB2(PTPI)
|
---|
| 92 | E D I +RESULT<0 W $P(RESULT,"^",2) Q ;..Process a normal entry
|
---|
| 93 | . S RESULT=$$BUILD^SCMCHLB(VARPTR,.HL,.XMITARRY)
|
---|
| 94 | . I +RESULT<0,'$D(ZTQUEUED) W $P(RESULT,"^",2)
|
---|
| 95 | ;
|
---|
| 96 | ;Generate message
|
---|
| 97 | GEN S RESULT=$$GENERATE^SCMCHLG()
|
---|
| 98 | ;
|
---|
| 99 | KILL @XMITARRY
|
---|
| 100 | Q:'$G(RESULT) ;No messages generated
|
---|
| 101 | D STATUS(TRANI,"RT") ;..Change STATUS to RT
|
---|
| 102 | W:'$D(ZTQUEUED) !,"Message re-transmitted..."
|
---|
| 103 | Q
|
---|
| 104 | ;
|
---|
| 105 | STATUS(TRANI,STATUS) ;Update STATUS field in PCMM HL7 TRANSMISSION LOG file.
|
---|
| 106 | ; Input: TRANI - IEN of PCM HL7 TRANSMISSION LOG file
|
---|
| 107 | ; STATUS - A=Accepted, M=Marked for re-transmit, RJ=Rejected
|
---|
| 108 | ;
|
---|
| 109 | NEW SCERR,SCFDA,SCIENS
|
---|
| 110 | Q:'$G(TRANI)
|
---|
| 111 | Q:($G(STATUS)']"")
|
---|
| 112 | S SCIENS=TRANI_","
|
---|
| 113 | S SCFDA(404.471,SCIENS,.04)=STATUS ;..Status
|
---|
| 114 | D FILE^DIE("I","SCFDA","SCERR")
|
---|
| 115 | Q
|
---|
| 116 | ;
|
---|
| 117 | AUTO(SCLIM) ;Auto retransmit messages that have not received an ACK.
|
---|
| 118 | ;Check all messages with a STATUS of "Transmitted" and see if
|
---|
| 119 | ;they've received an ACK. Then compare their transmit date to the
|
---|
| 120 | ;date in PCMM PARAMETER file HL7 TRANSMIT PERIOD field.
|
---|
| 121 | ;
|
---|
| 122 | ;Input:
|
---|
| 123 | ; SCLIM - maximum messages allowed to transmit passed by reference
|
---|
| 124 | ;
|
---|
| 125 | ;Output: none
|
---|
| 126 | ;
|
---|
| 127 | Q:'$D(SCLIM)
|
---|
| 128 | ;
|
---|
| 129 | NEW DAYSMAX,DAYSDIFF,ND,TODAY,TRANDT,TRANI
|
---|
| 130 | NEW DFN,SCDELETE,VARPTR
|
---|
| 131 | NEW MSGCNT,SCFAC,SCSEQ
|
---|
| 132 | ;
|
---|
| 133 | ;Initialize variables needed by GENERATE^SCMCHLG
|
---|
| 134 | S SCFAC=+$P($$SITE^VASITE(),"^",3) ;..Facility number
|
---|
| 135 | S MSGCNT=0 ;..........................Message count
|
---|
| 136 | ;
|
---|
| 137 | S TODAY=$$DT^XLFDT()
|
---|
| 138 | ;Get max days from HL7 PARAMETER file
|
---|
| 139 | S DAYSMAX=$P($G(^SCTM(404.44,1,1)),U,6)
|
---|
| 140 | I DAYSMAX="" S DAYSMAX=7 ;Default of 7 days
|
---|
| 141 | ;
|
---|
| 142 | S TRANI=0
|
---|
| 143 | F S TRANI=$O(^SCPT(404.471,"ASTAT","T",TRANI)) Q:'TRANI!(SCLIM<1) D
|
---|
| 144 | . S ND=$G(^SCPT(404.471,TRANI,0))
|
---|
| 145 | . Q:$P(ND,U,5) ;........ACK already received
|
---|
| 146 | . S TRANDT=$P(ND,U,3) ;..Date Transmitted
|
---|
| 147 | . ;
|
---|
| 148 | . ;Get number of days between Today and Transmit Date.
|
---|
| 149 | . S DAYSDIFF=$$FMDIFF^XLFDT(TODAY,TRANDT,1)
|
---|
| 150 | . ;
|
---|
| 151 | . ;Quit if required number of days hasn't passed
|
---|
| 152 | . Q:(DAYSDIFF<DAYSMAX)
|
---|
| 153 | . ;
|
---|
| 154 | . D GETDATA(TRANI) Q:VARPTR="" ;..Get DFN,VARPTR,SCDELETE
|
---|
| 155 | . N WORK S WORK=$P($G(^SCPT(404.471,+TRANI,0)),U,7)
|
---|
| 156 | . D RETRAN ;.......................Re-transmit message
|
---|
| 157 | Q
|
---|