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

IVMUFNC4.m

Go to the documentation of this file.
  1. IVMUFNC4 ;ALB/KCL - IVM UTILITIES ; 12/21/00 3:15pm
  1. ;;2.0;INCOME VERIFICATION MATCH;**1,9,13,18,34**; 21-OCT-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ;
  1. DAT1(X,Y) ; extrinsic function - convert FM date to displayable (mm/dd/yy) format.
  1. ;
  1. ; Input - X as FM date.time
  1. ; Y [optional] equal to 1 if time is to be returned
  1. ;
  1. ; Output - IVMDATE as (mm/dd/yy) and optional output of time, if $G(Y)
  1. ;
  1. N IVMDATE,T
  1. S IVMDATE=$S(X:$TR($$FMTE^XLFDT(X,"2DF")," ","0"),1:"")
  1. I $G(Y) S T="."_$E($P(X,".",2)_"000000",1,7) I T>0 S IVMDATE=IVMDATE_" "_$S($E(T,2,3)>12:$E(T,2,3)-12,1:+$E(T,2,3))_":"_$E(T,4,5)_$S($E(T,2,5)>1200:" pm",1:" am")
  1. Q IVMDATE
  1. ;
  1. ;
  1. DAT2(Y) ; extrinsic function - convert FM date to displayable (mmm dd yyyy) format
  1. ;
  1. ; Input - Y as FM date
  1. ;
  1. ; Output - Y as displayable (mmm dd yyyy) date
  1. ;
  1. N %
  1. Q:Y']"" "" D D^DIQ
  1. Q Y
  1. ;
  1. ;
  1. STATE1(X) ; extrinsic function - convert state abbreviation to state pointer
  1. ;
  1. ; Input - X as state abbreviation
  1. ;
  1. ; Output - pointer to STATE (#5) file
  1. ;
  1. Q:'$D(X) ""
  1. S X=$E(X,1,2)
  1. Q $S(X="":X,1:+$O(^DIC(5,"C",X,0)))
  1. ;
  1. ;
  1. PT(DFN) ; Returns patient name^long patient id^short patient id,
  1. ; or null if not found.
  1. ; Input: DFN -- Pointer to the patient in file #2
  1. N X S X=""
  1. I $G(DFN) S X=$G(^DPT(+DFN,0)) I X'="" S X=$P(X,"^",1)_"^"_$P($G(^DPT(DFN,.36)),"^",3,4)
  1. Q X
  1. ;
  1. ;
  1. NTE(DFN,IVMOUT,IVMMTDT) ; - entry point to get comments from a specified means test
  1. ;
  1. ; This function returns an array (specified by the user) which contains
  1. ; the comments associated with a specified means Test. The comments
  1. ; are formatted in HL7 NTE segments.
  1. ;
  1. ; Input: DFN as internal entry number from PATIENT (#2) file
  1. ; IVMOUT as specified reference array
  1. ; IVMMTDT as date of desired means test (default to latest MT)
  1. ;
  1. ; Output: IVMOUT array passed by reference containing comments
  1. ; formatted in HL7 NTE segments.
  1. ;
  1. ;
  1. N CTR,NODE,IVMDA,IVMIEN
  1. I '$G(DFN) G ENQ
  1. S IVMIEN=+$$LST^DGMTU(DFN,$S($G(IVMMTDT):IVMMTDT,1:DT))
  1. I $G(^DGMT(408.31,IVMIEN,"C",0))]"" D GET
  1. ENQ Q
  1. ;
  1. ;
  1. GET ; - get comment nodes and place in array
  1. S (CTR,IVMDA)=0
  1. F S IVMDA=$O(^DGMT(408.31,IVMIEN,"C",IVMDA)) Q:'IVMDA D
  1. .S NODE=$G(^DGMT(408.31,IVMIEN,"C",IVMDA,0))
  1. .I 'CTR,NODE="" Q ; line feed from screen editor, maybe?
  1. .F S CTR=CTR+1,IVMOUT(CTR)="NTE^"_CTR_"^^"_$E(NODE,1,120) Q:$L(NODE)'>120 S NODE=$E(NODE,121,255)
  1. Q
  1. ;
  1. ;
  1. MSH(IVMNOMSH,IVMFLL,IVMREC,IVMCT,IVMCNTID) ; --
  1. ; Description: Message header processing for HL7 full data transmissions (Z07).
  1. ;
  1. ; Input:
  1. ; IVMNOMSH - (optional) if IVMNOMSH=1, means MSH segment should
  1. ; not be built
  1. ; IVMFLL - (optional) flag for creating MSA, QRD segments for FULL
  1. ; query transmission, $G(IVMFLL) means yes.
  1. ; IVMREC - (optional) ien of #301.9001 multiple
  1. ; IVMCT - count of segments transmitted, pass by reference
  1. ;
  1. ; HL7 Variables:
  1. ; HLMTN - HL7 message type name
  1. ; HLECH - HL7 encoding characters
  1. ; HLSDT - a flag that indicates that the data to be sent is
  1. ; stored in the ^TMP("HLS") global array
  1. ; HLMID - message id from CREATE^HLTF
  1. ; HLEID - protocol id
  1. ; HL - array of protocol data from INIT^HLFNC2
  1. ;
  1. ; Output:
  1. ; ^TMP("HLS",$J,IVMCT) global array containing all segments of the HL7 message that the VistA application wishes to send. The HLSDT and IVMCT variables are defined above.
  1. ; IVMCNTID - as HL7 message control id concatenated with batch message counter, pass by reference
  1. ;
  1. N MID,RESULT
  1. D INIT^HLFNC2(HLEID,.HL)
  1. ;
  1. ;if MSH segment not needed, still need to compute IVMCNTID (msg controll id)
  1. I $G(IVMNOMSH) S IVMCNTID=$P($G(^TMP("HLS",$J,IVMCT-2)),HLFS,10)
  1. ;
  1. ; if not MSH segment, then build MSH segment
  1. I '$G(IVMNOMSH) D
  1. .S IVMCT=IVMCT+1
  1. .;
  1. .; - call HL7 utility to build MSH segment, set event type code
  1. .; for full transmission in MSH segment
  1. .S MID=HLMID_"-"_HLEVN
  1. .D MSH^HLFNC2(.HL,MID,.RESULT)
  1. .S ^TMP("HLS",$J,IVMCT)=RESULT
  1. .;
  1. .; - concatenate counter to msg control id (used for batch msgs)
  1. .D MSGID(.IVMCT)
  1. ;
  1. ; if flag for query response, create MSA & QRD segments
  1. I $G(IVMFLL) D
  1. .;
  1. .; - get query MSH segment control id of query message received from IVM
  1. .S IVMHLMID=$P($G(^IVM(301.9,1,10,+IVMREC,0)),"^",4)
  1. .;
  1. .; - create MSA segment, message control id must be referenced in
  1. .; response to query (full trans) sent back to IVM
  1. .S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)="MSA"_HLFS_"AA"_HLFS_IVMHLMID_HLFS
  1. .;
  1. .; - get QRD segment of query message received from IVM
  1. .S IVMQRD=$G(^IVM(301.9,1,10,+IVMREC,"ST"))
  1. .;
  1. .; - create QRD segment, must be transmitted back to IVM when
  1. .; responding to query rec'd from IVM
  1. .S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=IVMQRD
  1. ;
  1. Q
  1. ;
  1. ;
  1. MSGID(IVMCT) ; --
  1. ; Description: Put the batch number (HL7 msg event counter) into MSH
  1. ; segment. Concatinate msg control id with hyphen msg event counter.
  1. ;
  1. ; Input:
  1. ; IVMCT - count of segments transmitted, pass by reference
  1. ;
  1. ; HL7 Variables:
  1. ; HLEVN - HL7 message event counter (# of events in an HL7 msg)
  1. ; HLSDT - a flag that indicates that the data to be sent is
  1. ; stored in the ^TMP("HLS") global array
  1. ; HLFS - HL7 field separator
  1. ;
  1. ; Output:
  1. ; ^TMP("HLS",$J,IVMCT) global array containing all segments of the HL7 message that the VistA application wishes to send. The HLSDT and IVMCT variables are defined above.
  1. ;
  1. ; included logic to extract first piece of field (HL7 1.6 upgrade)
  1. ; just in case it has already been set
  1. S IVMCNTID=$P($P($G(^TMP("HLS",$J,IVMCT)),HLFS,10),"-",1)
  1. S IVMCNTID=IVMCNTID_"-"_HLEVN
  1. S $P(^TMP("HLS",$J,IVMCT),HLFS,10)=IVMCNTID
  1. Q
  1. ;
  1. ;
  1. IEN(X) ; Get the ien for a segment from HL7 SEGMENT (#771.3) file
  1. ; Input: X -- .01 field from file #771.3
  1. N DIC,Y
  1. S DIC="^HL(771.3,",DIC(0)="F" D ^DIC
  1. Q +Y
  1. ;
  1. ;
  1. BTCLM(DFN,INDATE) ; --
  1. ; Description: This function will be used to find a patients Beneficiary Travel claim record for the current income year.
  1. ;
  1. ; Input:
  1. ; DFN - internal entry number of Patient (#2) file
  1. ; INDATE - (optional) date that will be used to determine income year
  1. ; to begin claim search
  1. ;
  1. ; Output:
  1. ; Function Value - returns the internal entry number of the
  1. ; patients Beneficiary Travel claim record
  1. ; for the current income year, otherwise NULL.
  1. ;
  1. ; if DFN not passed, exit
  1. S IVMCLAIM="" I '$G(DFN) G BTCLMQ
  1. ;
  1. ; if INDATE not passed, default to today
  1. S INDATE=$S($D(INDATE):INDATE,1:DT)
  1. ;
  1. ; get most recent Beneficiary Travel claim for vet (reverse $O)
  1. S IVMCLAIM=$O(^DGBT(392,"C",DFN,IVMCLAIM),-1)
  1. ;
  1. ; if claim date not greater than 1/1 of INDATE year-1, set to null
  1. I $G(IVMCLAIM)'>($E(INDATE,1,3)-2_1231.999999) S IVMCLAIM=""
  1. ;
  1. ;
  1. BTCLMQ Q IVMCLAIM
  1. ;
  1. ;
  1. LD(DFN) ; --
  1. ; Description: This function will return a date based on the patient's
  1. ; last Means Test or Copay test.
  1. ; 1) The current year will be checked for a MT/CT, if found the
  1. ; current date will be returned.
  1. ; 2) The prior year will be checked for a MT/CT, if found the
  1. ; last day (12/31) of prior year will be returned.
  1. ; 3) Otherwise, the current date will be returned.
  1. ;
  1. ; Input:
  1. ; DFN - as patient IEN
  1. ;
  1. ; Output:
  1. ; Function Value - as date based on patient's last MT/CT
  1. ;
  1. N IVMLAST,IVMLD
  1. ;
  1. ; current date (default)
  1. S IVMLD=DT
  1. ;
  1. ; get date of last MT/CT for patient based on current date
  1. S IVMLAST=$P($$LST^DGMTCOU1(DFN,IVMLD),"^",2)
  1. ;
  1. D ; drop out of do block if condition true
  1. .;
  1. .; if MT/CT not found
  1. .I 'IVMLAST Q
  1. .;
  1. .; if date of last MT/CT = current year
  1. .I $E(IVMLAST,1,3)=$E(DT,1,3) Q
  1. .;
  1. .; if date of last MT/CT = previous year, use end-of-previous year
  1. .I $E(IVMLAST,1,3)=($E(DT,1,3)-1) S IVMLD=$E(DT,1,3)-1_1231 Q
  1. ;
  1. Q IVMLD