IVMPTRN4 ;ALB/SEK,TDM - SEND RE-TRANSMISSIONS TO THE IVM CENTER ; 8/15/08 10:29am
;;2.0;INCOME VERIFICATION MATCH;**9,11,17,34,66,81,86,115**; 21-OCT-94;Build 28
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; This routine checks STATUS field of IVM TRANSMISSION LOG file (301.6)
; to see if acknowledgment of the transmission has been received from
; the IVM Center. If transmission is waiting at the site, a message is
; sent to the recipients of the IVM MESSAGES mail group. Else the
; message is re-transmitted to the IVM Center.
;
;
ENTRY ; Check if message transmission has not been acknowledged for the
; following date range (IVMDMT3 through IVM14) where:
; IVMDMT3 - First Date Checked
; IVM14 - Last Date Checked
;
S IVMDTM3=$$FMADD^XLFDT(DT,-14),IVM14=$$FMADD^XLFDT(DT,-14)
S IVMDTMST=+$P($G(^IVM(301.9,1,0)),"^",6)
S:IVMDTMST<IVM14 IVMDTMST=IVM14
;
; INITIALIZE HL7 VARIABLES
N HL,HLEID
S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" ORU-Z07 SERVER"
S HLEID=$O(^ORD(101,"B",HLEID,0))
D INIT^IVMUFNC(HLEID,.HL) S HLMTN="ORU" ; Initialize variables for HL7/IVM
;
; check Transmission Date/Time in AB x-ref
; Note 2 oddities about this loop:
; 1) Only checks back 2 weeks, if somehow retransmission not done within this window then it won't be done.
; 2) Assumes IVMDAT will map to exactly one msgid for HL7 message - assumption made in $$MSGN^IVMPTRN4.
;
S IVMDAT=IVMDTMST F S IVMDAT=$O(^IVM(301.6,"AB",IVMDAT)) Q:'IVMDAT!($P(IVMDAT,".")>IVMDTM3) D MAILMSGN
;
;
;transmit remaining records
D
.N IVMEVENT
.; event code for Full Data Transmission
.S IVMEVENT="Z07"
.D FILE^IVMPTRN3
;
;clean-up
D END^IVMPTRN
;
ENTRYQ K IVMDAT,IVMMAILF,IVMDTM3,IVMDTMST,IVM14
Q
;
;
MAILMSGN ; Get Mailman message number related to this transmission
S IVMMAILN=$$MSGN(IVMDAT) ;returns #773 IEN for v1.6
;
Q:'IVMMAILN ; if no #773 IEN found
;
; find if awaiting initial transmission
N SLLN
S SLLN=+$P($G(^HLMA(IVMMAILN,0)),"^",7) ; sending logical link
I SLLN,$D(^HLMA("AC","O",SLLN,IVMMAILN)) D Q
.Q:$G(IVMMAILF) ; already sent message once
.S XMSUB="MESSAGES 'AWAITING TRANSMISSION'"
.S IVMTEXT(1)="HL7 message number "_IVMMAILN_" is awaiting transmission."
.S IVMTEXT(2)="Please call the IVM Center (Atlanta, GA) to ensure the HL7 logical links and filers are running "
.S IVMTEXT(3)="if the HL7 logical link and filers are running at your station."
.S IVMTEXT(4)=" "
.S IVMTEXT(5)="Please note that you may have other messages that are awaiting transmission"
.S IVMTEXT(6)="to the IVM Center."
.D MAIL^IVMUFNC()
.S IVMMAILF=1
;
; Transmission has left site - get individual patient and re-transmit
K IVMQUERY("LTD"),IVMQUERY("OVIS") ;Variables needed to open/close last visit date and outpt visit QUERIES
F IVMDA=0:0 S IVMDA=$O(^IVM(301.6,"AB",IVMDAT,IVMDA)) Q:'IVMDA D
.;
.N IVMTLOG,EVENTS
.;
.Q:'$$GET^IVMTLOG(IVMDA,.IVMTLOG)
.S IVM3015P=IVMTLOG("PAT") Q:'IVM3015P
.S IVMNODE=$G(^IVM(301.5,+IVM3015P,0)),(IVMDT,IVMIY)=+$P(IVMNODE,"^",2),DFN=+IVMNODE
.I 'DFN!'IVMDT Q
.S IVMMTDT=($E(IVMDT,1,3)+1)_"1231.9999"
.I $E(IVMMTDT,1,3)'=($E(IVMDT,1,3)+1) S IVMMTDT=$E(IVMDT,1,3)+1_"0101"
.;
.M EVENTS=IVMTLOG("EVENTS")
.;
.; Prepare FULL transmission
.D FULL^IVMPTRN7(DFN,IVMMTDT,.EVENTS,.IVMCT,.IVMGTOT,,,,.IVMQUERY)
.;
.;change status to retransmitted
.I $$SETSTAT^IVMTLOG(IVMDA,2)
F Z="LTD","OVIS" I $G(IVMQUERY(Z)) D CLOSE^SDQ(IVMQUERY(Z)) K IVMQUERY(Z)
Q
;
MSGN(IVMDT) ; Find the mailman message number for an HL7 message
; Input: IVMDT -- The date/time (301.6;.02) the msg was sent
; Output: Pointer to the message in file #773, or zero if not found
N IVMMSG,X S IVMMSG=0
S X=+$O(^IVM(301.6,"AB",IVMDT,0)),X=$G(^IVM(301.6,X,0))
I X S IVMMSG=$$MMN(+$P($P(X,"^",5),"-"))
MSGNQ Q IVMMSG
;
MMN(Y) ; Do look-up on file #772 and find mail message number.
; Input: Y -- Message Control ID
; Output: Mail Message Number
N Z S Z=0
S Y=$O(^HL(772,"C",Y,0))
I Y S Z=+$O(^HLMA("B",Y,0)) ;Y=#772 IEN, Z=#773 IEN
MMNQ Q Z
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMPTRN4 4199 printed Dec 13, 2024@02:02:27 Page 2
IVMPTRN4 ;ALB/SEK,TDM - SEND RE-TRANSMISSIONS TO THE IVM CENTER ; 8/15/08 10:29am
+1 ;;2.0;INCOME VERIFICATION MATCH;**9,11,17,34,66,81,86,115**; 21-OCT-94;Build 28
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; This routine checks STATUS field of IVM TRANSMISSION LOG file (301.6)
+5 ; to see if acknowledgment of the transmission has been received from
+6 ; the IVM Center. If transmission is waiting at the site, a message is
+7 ; sent to the recipients of the IVM MESSAGES mail group. Else the
+8 ; message is re-transmitted to the IVM Center.
+9 ;
+10 ;
ENTRY ; Check if message transmission has not been acknowledged for the
+1 ; following date range (IVMDMT3 through IVM14) where:
+2 ; IVMDMT3 - First Date Checked
+3 ; IVM14 - Last Date Checked
+4 ;
+5 SET IVMDTM3=$$FMADD^XLFDT(DT,-14)
SET IVM14=$$FMADD^XLFDT(DT,-14)
+6 SET IVMDTMST=+$PIECE($GET(^IVM(301.9,1,0)),"^",6)
+7 if IVMDTMST<IVM14
SET IVMDTMST=IVM14
+8 ;
+9 ; INITIALIZE HL7 VARIABLES
+10 NEW HL,HLEID
+11 SET HLEID="VAMC "_$PIECE($$SITE^VASITE,"^",3)_" ORU-Z07 SERVER"
+12 SET HLEID=$ORDER(^ORD(101,"B",HLEID,0))
+13 ; Initialize variables for HL7/IVM
DO INIT^IVMUFNC(HLEID,.HL)
SET HLMTN="ORU"
+14 ;
+15 ; check Transmission Date/Time in AB x-ref
+16 ; Note 2 oddities about this loop:
+17 ; 1) Only checks back 2 weeks, if somehow retransmission not done within this window then it won't be done.
+18 ; 2) Assumes IVMDAT will map to exactly one msgid for HL7 message - assumption made in $$MSGN^IVMPTRN4.
+19 ;
+20 SET IVMDAT=IVMDTMST
FOR
SET IVMDAT=$ORDER(^IVM(301.6,"AB",IVMDAT))
if 'IVMDAT!($PIECE(IVMDAT,".")>IVMDTM3)
QUIT
DO MAILMSGN
+21 ;
+22 ;
+23 ;transmit remaining records
+24 Begin DoDot:1
+25 NEW IVMEVENT
+26 ; event code for Full Data Transmission
+27 SET IVMEVENT="Z07"
+28 DO FILE^IVMPTRN3
End DoDot:1
+29 ;
+30 ;clean-up
+31 DO END^IVMPTRN
+32 ;
ENTRYQ KILL IVMDAT,IVMMAILF,IVMDTM3,IVMDTMST,IVM14
+1 QUIT
+2 ;
+3 ;
MAILMSGN ; Get Mailman message number related to this transmission
+1 ;returns #773 IEN for v1.6
SET IVMMAILN=$$MSGN(IVMDAT)
+2 ;
+3 ; if no #773 IEN found
if 'IVMMAILN
QUIT
+4 ;
+5 ; find if awaiting initial transmission
+6 NEW SLLN
+7 ; sending logical link
SET SLLN=+$PIECE($GET(^HLMA(IVMMAILN,0)),"^",7)
+8 IF SLLN
IF $DATA(^HLMA("AC","O",SLLN,IVMMAILN))
Begin DoDot:1
+9 ; already sent message once
if $GET(IVMMAILF)
QUIT
+10 SET XMSUB="MESSAGES 'AWAITING TRANSMISSION'"
+11 SET IVMTEXT(1)="HL7 message number "_IVMMAILN_" is awaiting transmission."
+12 SET IVMTEXT(2)="Please call the IVM Center (Atlanta, GA) to ensure the HL7 logical links and filers are running "
+13 SET IVMTEXT(3)="if the HL7 logical link and filers are running at your station."
+14 SET IVMTEXT(4)=" "
+15 SET IVMTEXT(5)="Please note that you may have other messages that are awaiting transmission"
+16 SET IVMTEXT(6)="to the IVM Center."
+17 DO MAIL^IVMUFNC()
+18 SET IVMMAILF=1
End DoDot:1
QUIT
+19 ;
+20 ; Transmission has left site - get individual patient and re-transmit
+21 ;Variables needed to open/close last visit date and outpt visit QUERIES
KILL IVMQUERY("LTD"),IVMQUERY("OVIS")
+22 FOR IVMDA=0:0
SET IVMDA=$ORDER(^IVM(301.6,"AB",IVMDAT,IVMDA))
if 'IVMDA
QUIT
Begin DoDot:1
+23 ;
+24 NEW IVMTLOG,EVENTS
+25 ;
+26 if '$$GET^IVMTLOG(IVMDA,.IVMTLOG)
QUIT
+27 SET IVM3015P=IVMTLOG("PAT")
if 'IVM3015P
QUIT
+28 SET IVMNODE=$GET(^IVM(301.5,+IVM3015P,0))
SET (IVMDT,IVMIY)=+$PIECE(IVMNODE,"^",2)
SET DFN=+IVMNODE
+29 IF 'DFN!'IVMDT
QUIT
+30 SET IVMMTDT=($EXTRACT(IVMDT,1,3)+1)_"1231.9999"
+31 IF $EXTRACT(IVMMTDT,1,3)'=($EXTRACT(IVMDT,1,3)+1)
SET IVMMTDT=$EXTRACT(IVMDT,1,3)+1_"0101"
+32 ;
+33 MERGE EVENTS=IVMTLOG("EVENTS")
+34 ;
+35 ; Prepare FULL transmission
+36 DO FULL^IVMPTRN7(DFN,IVMMTDT,.EVENTS,.IVMCT,.IVMGTOT,,,,.IVMQUERY)
+37 ;
+38 ;change status to retransmitted
+39 IF $$SETSTAT^IVMTLOG(IVMDA,2)
End DoDot:1
+40 FOR Z="LTD","OVIS"
IF $GET(IVMQUERY(Z))
DO CLOSE^SDQ(IVMQUERY(Z))
KILL IVMQUERY(Z)
+41 QUIT
+42 ;
MSGN(IVMDT) ; Find the mailman message number for an HL7 message
+1 ; Input: IVMDT -- The date/time (301.6;.02) the msg was sent
+2 ; Output: Pointer to the message in file #773, or zero if not found
+3 NEW IVMMSG,X
SET IVMMSG=0
+4 SET X=+$ORDER(^IVM(301.6,"AB",IVMDT,0))
SET X=$GET(^IVM(301.6,X,0))
+5 IF X
SET IVMMSG=$$MMN(+$PIECE($PIECE(X,"^",5),"-"))
MSGNQ QUIT IVMMSG
+1 ;
MMN(Y) ; Do look-up on file #772 and find mail message number.
+1 ; Input: Y -- Message Control ID
+2 ; Output: Mail Message Number
+3 NEW Z
SET Z=0
+4 SET Y=$ORDER(^HL(772,"C",Y,0))
+5 ;Y=#772 IEN, Z=#773 IEN
IF Y
SET Z=+$ORDER(^HLMA("B",Y,0))
MMNQ QUIT Z
