Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IVMPTRN4

IVMPTRN4.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ; This routine checks STATUS field of IVM TRANSMISSION LOG file (301.6)
  1. ; to see if acknowledgment of the transmission has been received from
  1. ; the IVM Center. If transmission is waiting at the site, a message is
  1. ; sent to the recipients of the IVM MESSAGES mail group. Else the
  1. ; message is re-transmitted to the IVM Center.
  1. ;
  1. ;
  1. ENTRY ; Check if message transmission has not been acknowledged for the
  1. ; following date range (IVMDMT3 through IVM14) where:
  1. ; IVMDMT3 - First Date Checked
  1. ; IVM14 - Last Date Checked
  1. ;
  1. S IVMDTM3=$$FMADD^XLFDT(DT,-14),IVM14=$$FMADD^XLFDT(DT,-14)
  1. S IVMDTMST=+$P($G(^IVM(301.9,1,0)),"^",6)
  1. S:IVMDTMST<IVM14 IVMDTMST=IVM14
  1. ;
  1. ; INITIALIZE HL7 VARIABLES
  1. N HL,HLEID
  1. S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" ORU-Z07 SERVER"
  1. S HLEID=$O(^ORD(101,"B",HLEID,0))
  1. D INIT^IVMUFNC(HLEID,.HL) S HLMTN="ORU" ; Initialize variables for HL7/IVM
  1. ;
  1. ; check Transmission Date/Time in AB x-ref
  1. ; Note 2 oddities about this loop:
  1. ; 1) Only checks back 2 weeks, if somehow retransmission not done within this window then it won't be done.
  1. ; 2) Assumes IVMDAT will map to exactly one msgid for HL7 message - assumption made in $$MSGN^IVMPTRN4.
  1. ;
  1. S IVMDAT=IVMDTMST F S IVMDAT=$O(^IVM(301.6,"AB",IVMDAT)) Q:'IVMDAT!($P(IVMDAT,".")>IVMDTM3) D MAILMSGN
  1. ;
  1. ;
  1. ;transmit remaining records
  1. D
  1. .N IVMEVENT
  1. .; event code for Full Data Transmission
  1. .S IVMEVENT="Z07"
  1. .D FILE^IVMPTRN3
  1. ;
  1. ;clean-up
  1. D END^IVMPTRN
  1. ;
  1. ENTRYQ K IVMDAT,IVMMAILF,IVMDTM3,IVMDTMST,IVM14
  1. Q
  1. ;
  1. ;
  1. MAILMSGN ; Get Mailman message number related to this transmission
  1. S IVMMAILN=$$MSGN(IVMDAT) ;returns #773 IEN for v1.6
  1. ;
  1. Q:'IVMMAILN ; if no #773 IEN found
  1. ;
  1. ; find if awaiting initial transmission
  1. N SLLN
  1. S SLLN=+$P($G(^HLMA(IVMMAILN,0)),"^",7) ; sending logical link
  1. I SLLN,$D(^HLMA("AC","O",SLLN,IVMMAILN)) D Q
  1. .Q:$G(IVMMAILF) ; already sent message once
  1. .S XMSUB="MESSAGES 'AWAITING TRANSMISSION'"
  1. .S IVMTEXT(1)="HL7 message number "_IVMMAILN_" is awaiting transmission."
  1. .S IVMTEXT(2)="Please call the IVM Center (Atlanta, GA) to ensure the HL7 logical links and filers are running "
  1. .S IVMTEXT(3)="if the HL7 logical link and filers are running at your station."
  1. .S IVMTEXT(4)=" "
  1. .S IVMTEXT(5)="Please note that you may have other messages that are awaiting transmission"
  1. .S IVMTEXT(6)="to the IVM Center."
  1. .D MAIL^IVMUFNC()
  1. .S IVMMAILF=1
  1. ;
  1. ; Transmission has left site - get individual patient and re-transmit
  1. K IVMQUERY("LTD"),IVMQUERY("OVIS") ;Variables needed to open/close last visit date and outpt visit QUERIES
  1. F IVMDA=0:0 S IVMDA=$O(^IVM(301.6,"AB",IVMDAT,IVMDA)) Q:'IVMDA D
  1. .;
  1. .N IVMTLOG,EVENTS
  1. .;
  1. .Q:'$$GET^IVMTLOG(IVMDA,.IVMTLOG)
  1. .S IVM3015P=IVMTLOG("PAT") Q:'IVM3015P
  1. .S IVMNODE=$G(^IVM(301.5,+IVM3015P,0)),(IVMDT,IVMIY)=+$P(IVMNODE,"^",2),DFN=+IVMNODE
  1. .I 'DFN!'IVMDT Q
  1. .S IVMMTDT=($E(IVMDT,1,3)+1)_"1231.9999"
  1. .I $E(IVMMTDT,1,3)'=($E(IVMDT,1,3)+1) S IVMMTDT=$E(IVMDT,1,3)+1_"0101"
  1. .;
  1. .M EVENTS=IVMTLOG("EVENTS")
  1. .;
  1. .; Prepare FULL transmission
  1. .D FULL^IVMPTRN7(DFN,IVMMTDT,.EVENTS,.IVMCT,.IVMGTOT,,,,.IVMQUERY)
  1. .;
  1. .;change status to retransmitted
  1. .I $$SETSTAT^IVMTLOG(IVMDA,2)
  1. F Z="LTD","OVIS" I $G(IVMQUERY(Z)) D CLOSE^SDQ(IVMQUERY(Z)) K IVMQUERY(Z)
  1. Q
  1. ;
  1. MSGN(IVMDT) ; Find the mailman message number for an HL7 message
  1. ; Input: IVMDT -- The date/time (301.6;.02) the msg was sent
  1. ; Output: Pointer to the message in file #773, or zero if not found
  1. N IVMMSG,X S IVMMSG=0
  1. S X=+$O(^IVM(301.6,"AB",IVMDT,0)),X=$G(^IVM(301.6,X,0))
  1. I X S IVMMSG=$$MMN(+$P($P(X,"^",5),"-"))
  1. MSGNQ Q IVMMSG
  1. ;
  1. MMN(Y) ; Do look-up on file #772 and find mail message number.
  1. ; Input: Y -- Message Control ID
  1. ; Output: Mail Message Number
  1. N Z S Z=0
  1. S Y=$O(^HL(772,"C",Y,0))
  1. I Y S Z=+$O(^HLMA("B",Y,0)) ;Y=#772 IEN, Z=#773 IEN
  1. MMNQ Q Z