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