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 Sep 23, 2025@20:17:03 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
