- SCMCHLRR ;BP/DJB - PCMM HL7 Rejects - Resubmit ; 3/6/00 12:14pm
- ;;5.3;Scheduling;**210,224,272**;AUG 13, 1993
- ;
- EN(SCLIM) ;Entry point for retransmitting "M"arked messages
- ;
- ;Input:
- ; SCLIM - maximum messages allowed per batch passed by reference
- ;
- ;Output: none
- ;
- Q:'$D(SCLIM)
- ;
- NEW DFN,SCDELETE,VARPTR
- NEW MSGCNT,SCFAC,SCSEQ
- ;
- ;Send notification msg if new HL7 reject transmissions received
- D NOTIFY^SCMCHLM
- ;
- ;Initialize variables needed by GENERATE^SCMCHLG
- S SCFAC=+$P($$SITE^VASITE(),"^",3) ;..Facility number
- S MSGCNT=0 ;..........................Message count
- ;
- ;Loop thru PCMM HL7 TRANSMISSION LOG and resubmit items
- D LOOP
- ;
- EXIT ;
- Q
- ;
- ;
- LOOP ;Loop thru PCMM HL7 TRANSMISSION LOG file and find every entry
- ;with STATUS="M", and re-transmit.
- ;
- NEW TRANI
- S TRANI=0
- F S TRANI=$O(^SCPT(404.471,"ASTAT","M",TRANI)) Q:'TRANI!(SCLIM<1) D
- . N WORK S (WORK,VARPTR)=$P($G(^SCPT(404.471,+TRANI,0)),U,7)
- . I '$G(WORK) D GETDATA(TRANI) ;..Get DFN,VARPTR,SCDELETE
- . ;alb/rpm - Missing ZPC segment messages will not retransmit.
- . ; Clear the entry by setting status to "RT".
- . I VARPTR="" D STATUS(TRANI,"RT") Q
- . D RETRAN ;.......................Re-transmit message
- Q
- GETDATA(TRANI) ;Get DFN & VARPTR from PCMM HL7 TRANSMISSION LOG file
- ; Input:
- ; TRANI - IEN to file PCMM HL7 TRANSMISSION LOG file (#404.471)
- ;Output:
- ; DFN - Patient IEN
- ; VARPTR - Variable pointer to 404.43 (ex: "2404;SCPT(404.43,")
- ; SCDELETE - Flag to process a delete
- ;
- NEW IDI,IDLONG,ND,PTPI
- ;
- ;Initialize return variables
- S (DFN,VARPTR)=""
- S SCDELETE=0
- ;
- S IDI=$O(^SCPT(404.471,TRANI,"ZPC","C",0)) Q:'IDI
- S ND=$G(^SCPT(404.49,IDI,0)) ;............PCMM HL7 ID zero node
- S IDLONG=$P(ND,U,1) ;.....................Get long form of ID
- ;alb/rpm;Patch 224;Fix DFN retrieval to prevent missing PID/EVN segments
- S DFN=$P($G(^SCPT(404.471,TRANI,0)),U,2) Q:'DFN
- S PTPI=$P(IDLONG,"-",1) ;.................File 404.43 IEN
- Q:'PTPI
- I '$D(^SCPT(404.43,PTPI)) S SCDELETE=1 ;..Flag to process a delete
- S VARPTR=PTPI_";SCPT(404.43," ;...........Create event pointer
- Q
- ;
- RETRAN ;Re-transmit messages.
- ;
- NEW PT,PTPI,RESULT,XMITARRY
- NEW HL,HLECH,HLEID,HLFS,HLQ
- ;
- ;Initialize array
- S XMITARRY="^TMP(""PCMM"",""HL7"","_$J_")" ;..Segments
- KILL @XMITARRY
- ;
- ;Get pointer to sending event
- S HLEID=$$HLEID^SCMCHL()
- I 'HLEID D Q
- . Q:$D(ZTQUEUED)
- . W "Unable to initialize HL7 variables - protocol not found"
- ;
- ;Initialize HL7 variables
- D INIT^HLFNC2(HLEID,.HL)
- I $G(WORK) S RESULT=$$BUILD^SCMCHLP(VARPTR,.HL,.XMITARRY,$G(TRANI)) D GEN Q
- I $O(HL(""))="" W:'$D(ZTQUEUED) $P(HL,"^",2) Q
- ;
- ;Build segment array
- I $G(SCDELETE) D I 1 ;....................Process a deletion
- . S PTPI=$P(VARPTR,";",1)
- . D PTPD^SCMCHLB2(PTPI)
- E D I +RESULT<0 W $P(RESULT,"^",2) Q ;..Process a normal entry
- . S RESULT=$$BUILD^SCMCHLB(VARPTR,.HL,.XMITARRY)
- . I +RESULT<0,'$D(ZTQUEUED) W $P(RESULT,"^",2)
- ;
- ;Generate message
- GEN S RESULT=$$GENERATE^SCMCHLG()
- ;
- KILL @XMITARRY
- Q:'$G(RESULT) ;No messages generated
- D STATUS(TRANI,"RT") ;..Change STATUS to RT
- W:'$D(ZTQUEUED) !,"Message re-transmitted..."
- Q
- ;
- STATUS(TRANI,STATUS) ;Update STATUS field in PCMM HL7 TRANSMISSION LOG file.
- ; Input: TRANI - IEN of PCM HL7 TRANSMISSION LOG file
- ; STATUS - A=Accepted, M=Marked for re-transmit, RJ=Rejected
- ;
- NEW SCERR,SCFDA,SCIENS
- Q:'$G(TRANI)
- Q:($G(STATUS)']"")
- S SCIENS=TRANI_","
- S SCFDA(404.471,SCIENS,.04)=STATUS ;..Status
- D FILE^DIE("I","SCFDA","SCERR")
- Q
- ;
- AUTO(SCLIM) ;Auto retransmit messages that have not received an ACK.
- ;Check all messages with a STATUS of "Transmitted" and see if
- ;they've received an ACK. Then compare their transmit date to the
- ;date in PCMM PARAMETER file HL7 TRANSMIT PERIOD field.
- ;
- ;Input:
- ; SCLIM - maximum messages allowed to transmit passed by reference
- ;
- ;Output: none
- ;
- Q:'$D(SCLIM)
- ;
- NEW DAYSMAX,DAYSDIFF,ND,TODAY,TRANDT,TRANI
- NEW DFN,SCDELETE,VARPTR
- NEW MSGCNT,SCFAC,SCSEQ
- ;
- ;Initialize variables needed by GENERATE^SCMCHLG
- S SCFAC=+$P($$SITE^VASITE(),"^",3) ;..Facility number
- S MSGCNT=0 ;..........................Message count
- ;
- S TODAY=$$DT^XLFDT()
- ;Get max days from HL7 PARAMETER file
- S DAYSMAX=$P($G(^SCTM(404.44,1,1)),U,6)
- I DAYSMAX="" S DAYSMAX=7 ;Default of 7 days
- ;
- S TRANI=0
- F S TRANI=$O(^SCPT(404.471,"ASTAT","T",TRANI)) Q:'TRANI!(SCLIM<1) D
- . S ND=$G(^SCPT(404.471,TRANI,0))
- . Q:$P(ND,U,5) ;........ACK already received
- . S TRANDT=$P(ND,U,3) ;..Date Transmitted
- . ;
- . ;Get number of days between Today and Transmit Date.
- . S DAYSDIFF=$$FMDIFF^XLFDT(TODAY,TRANDT,1)
- . ;
- . ;Quit if required number of days hasn't passed
- . Q:(DAYSDIFF<DAYSMAX)
- . ;
- . D GETDATA(TRANI) Q:VARPTR="" ;..Get DFN,VARPTR,SCDELETE
- . N WORK S WORK=$P($G(^SCPT(404.471,+TRANI,0)),U,7)
- . D RETRAN ;.......................Re-transmit message
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCHLRR 5041 printed Jan 18, 2025@03:41:50 Page 2
- SCMCHLRR ;BP/DJB - PCMM HL7 Rejects - Resubmit ; 3/6/00 12:14pm
- +1 ;;5.3;Scheduling;**210,224,272**;AUG 13, 1993
- +2 ;
- EN(SCLIM) ;Entry point for retransmitting "M"arked messages
- +1 ;
- +2 ;Input:
- +3 ; SCLIM - maximum messages allowed per batch passed by reference
- +4 ;
- +5 ;Output: none
- +6 ;
- +7 if '$DATA(SCLIM)
- QUIT
- +8 ;
- +9 NEW DFN,SCDELETE,VARPTR
- +10 NEW MSGCNT,SCFAC,SCSEQ
- +11 ;
- +12 ;Send notification msg if new HL7 reject transmissions received
- +13 DO NOTIFY^SCMCHLM
- +14 ;
- +15 ;Initialize variables needed by GENERATE^SCMCHLG
- +16 ;..Facility number
- SET SCFAC=+$PIECE($$SITE^VASITE(),"^",3)
- +17 ;..........................Message count
- SET MSGCNT=0
- +18 ;
- +19 ;Loop thru PCMM HL7 TRANSMISSION LOG and resubmit items
- +20 DO LOOP
- +21 ;
- EXIT ;
- +1 QUIT
- +2 ;
- +3 ;
- LOOP ;Loop thru PCMM HL7 TRANSMISSION LOG file and find every entry
- +1 ;with STATUS="M", and re-transmit.
- +2 ;
- +3 NEW TRANI
- +4 SET TRANI=0
- +5 FOR
- SET TRANI=$ORDER(^SCPT(404.471,"ASTAT","M",TRANI))
- if 'TRANI!(SCLIM<1)
- QUIT
- Begin DoDot:1
- +6 NEW WORK
- SET (WORK,VARPTR)=$PIECE($GET(^SCPT(404.471,+TRANI,0)),U,7)
- +7 ;..Get DFN,VARPTR,SCDELETE
- IF '$GET(WORK)
- DO GETDATA(TRANI)
- +8 ;alb/rpm - Missing ZPC segment messages will not retransmit.
- +9 ; Clear the entry by setting status to "RT".
- +10 IF VARPTR=""
- DO STATUS(TRANI,"RT")
- QUIT
- +11 ;.......................Re-transmit message
- DO RETRAN
- End DoDot:1
- +12 QUIT
- GETDATA(TRANI) ;Get DFN & VARPTR from PCMM HL7 TRANSMISSION LOG file
- +1 ; Input:
- +2 ; TRANI - IEN to file PCMM HL7 TRANSMISSION LOG file (#404.471)
- +3 ;Output:
- +4 ; DFN - Patient IEN
- +5 ; VARPTR - Variable pointer to 404.43 (ex: "2404;SCPT(404.43,")
- +6 ; SCDELETE - Flag to process a delete
- +7 ;
- +8 NEW IDI,IDLONG,ND,PTPI
- +9 ;
- +10 ;Initialize return variables
- +11 SET (DFN,VARPTR)=""
- +12 SET SCDELETE=0
- +13 ;
- +14 SET IDI=$ORDER(^SCPT(404.471,TRANI,"ZPC","C",0))
- if 'IDI
- QUIT
- +15 ;............PCMM HL7 ID zero node
- SET ND=$GET(^SCPT(404.49,IDI,0))
- +16 ;.....................Get long form of ID
- SET IDLONG=$PIECE(ND,U,1)
- +17 ;alb/rpm;Patch 224;Fix DFN retrieval to prevent missing PID/EVN segments
- +18 SET DFN=$PIECE($GET(^SCPT(404.471,TRANI,0)),U,2)
- if 'DFN
- QUIT
- +19 ;.................File 404.43 IEN
- SET PTPI=$PIECE(IDLONG,"-",1)
- +20 if 'PTPI
- QUIT
- +21 ;..Flag to process a delete
- IF '$DATA(^SCPT(404.43,PTPI))
- SET SCDELETE=1
- +22 ;...........Create event pointer
- SET VARPTR=PTPI_";SCPT(404.43,"
- +23 QUIT
- +24 ;
- RETRAN ;Re-transmit messages.
- +1 ;
- +2 NEW PT,PTPI,RESULT,XMITARRY
- +3 NEW HL,HLECH,HLEID,HLFS,HLQ
- +4 ;
- +5 ;Initialize array
- +6 ;..Segments
- SET XMITARRY="^TMP(""PCMM"",""HL7"","_$JOB_")"
- +7 KILL @XMITARRY
- +8 ;
- +9 ;Get pointer to sending event
- +10 SET HLEID=$$HLEID^SCMCHL()
- +11 IF 'HLEID
- Begin DoDot:1
- +12 if $DATA(ZTQUEUED)
- QUIT
- +13 WRITE "Unable to initialize HL7 variables - protocol not found"
- End DoDot:1
- QUIT
- +14 ;
- +15 ;Initialize HL7 variables
- +16 DO INIT^HLFNC2(HLEID,.HL)
- +17 IF $GET(WORK)
- SET RESULT=$$BUILD^SCMCHLP(VARPTR,.HL,.XMITARRY,$GET(TRANI))
- DO GEN
- QUIT
- +18 IF $ORDER(HL(""))=""
- if '$DATA(ZTQUEUED)
- WRITE $PIECE(HL,"^",2)
- QUIT
- +19 ;
- +20 ;Build segment array
- +21 ;....................Process a deletion
- IF $GET(SCDELETE)
- Begin DoDot:1
- +22 SET PTPI=$PIECE(VARPTR,";",1)
- +23 DO PTPD^SCMCHLB2(PTPI)
- End DoDot:1
- IF 1
- +24 ;..Process a normal entry
- IF '$TEST
- Begin DoDot:1
- +25 SET RESULT=$$BUILD^SCMCHLB(VARPTR,.HL,.XMITARRY)
- +26 IF +RESULT<0
- IF '$DATA(ZTQUEUED)
- WRITE $PIECE(RESULT,"^",2)
- End DoDot:1
- IF +RESULT<0
- WRITE $PIECE(RESULT,"^",2)
- QUIT
- +27 ;
- +28 ;Generate message
- GEN SET RESULT=$$GENERATE^SCMCHLG()
- +1 ;
- +2 KILL @XMITARRY
- +3 ;No messages generated
- if '$GET(RESULT)
- QUIT
- +4 ;..Change STATUS to RT
- DO STATUS(TRANI,"RT")
- +5 if '$DATA(ZTQUEUED)
- WRITE !,"Message re-transmitted..."
- +6 QUIT
- +7 ;
- STATUS(TRANI,STATUS) ;Update STATUS field in PCMM HL7 TRANSMISSION LOG file.
- +1 ; Input: TRANI - IEN of PCM HL7 TRANSMISSION LOG file
- +2 ; STATUS - A=Accepted, M=Marked for re-transmit, RJ=Rejected
- +3 ;
- +4 NEW SCERR,SCFDA,SCIENS
- +5 if '$GET(TRANI)
- QUIT
- +6 if ($GET(STATUS)']"")
- QUIT
- +7 SET SCIENS=TRANI_","
- +8 ;..Status
- SET SCFDA(404.471,SCIENS,.04)=STATUS
- +9 DO FILE^DIE("I","SCFDA","SCERR")
- +10 QUIT
- +11 ;
- AUTO(SCLIM) ;Auto retransmit messages that have not received an ACK.
- +1 ;Check all messages with a STATUS of "Transmitted" and see if
- +2 ;they've received an ACK. Then compare their transmit date to the
- +3 ;date in PCMM PARAMETER file HL7 TRANSMIT PERIOD field.
- +4 ;
- +5 ;Input:
- +6 ; SCLIM - maximum messages allowed to transmit passed by reference
- +7 ;
- +8 ;Output: none
- +9 ;
- +10 if '$DATA(SCLIM)
- QUIT
- +11 ;
- +12 NEW DAYSMAX,DAYSDIFF,ND,TODAY,TRANDT,TRANI
- +13 NEW DFN,SCDELETE,VARPTR
- +14 NEW MSGCNT,SCFAC,SCSEQ
- +15 ;
- +16 ;Initialize variables needed by GENERATE^SCMCHLG
- +17 ;..Facility number
- SET SCFAC=+$PIECE($$SITE^VASITE(),"^",3)
- +18 ;..........................Message count
- SET MSGCNT=0
- +19 ;
- +20 SET TODAY=$$DT^XLFDT()
- +21 ;Get max days from HL7 PARAMETER file
- +22 SET DAYSMAX=$PIECE($GET(^SCTM(404.44,1,1)),U,6)
- +23 ;Default of 7 days
- IF DAYSMAX=""
- SET DAYSMAX=7
- +24 ;
- +25 SET TRANI=0
- +26 FOR
- SET TRANI=$ORDER(^SCPT(404.471,"ASTAT","T",TRANI))
- if 'TRANI!(SCLIM<1)
- QUIT
- Begin DoDot:1
- +27 SET ND=$GET(^SCPT(404.471,TRANI,0))
- +28 ;........ACK already received
- if $PIECE(ND,U,5)
- QUIT
- +29 ;..Date Transmitted
- SET TRANDT=$PIECE(ND,U,3)
- +30 ;
- +31 ;Get number of days between Today and Transmit Date.
- +32 SET DAYSDIFF=$$FMDIFF^XLFDT(TODAY,TRANDT,1)
- +33 ;
- +34 ;Quit if required number of days hasn't passed
- +35 if (DAYSDIFF<DAYSMAX)
- QUIT
- +36 ;
- +37 ;..Get DFN,VARPTR,SCDELETE
- DO GETDATA(TRANI)
- if VARPTR=""
- QUIT
- +38 NEW WORK
- SET WORK=$PIECE($GET(^SCPT(404.471,+TRANI,0)),U,7)
- +39 ;.......................Re-transmit message
- DO RETRAN
- End DoDot:1
- +40 QUIT