- 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 Jan 18, 2025@03:02:51 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