IVMPLOG ;ALB/CJM,RTK,ERC,KUM - API for IVM PATIENT file; ; 8/15/08 12:49pm
;;2.0;INCOME VERIFICATION MATCH;**9,19,12,21,17,28,36,40,49,68,115,194**; 21-OCT-94;Build 34
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;
FIND(DFN,YEAR) ;
;Description: Looks up an entry in the IVM PATIENT file (#301.5).
;Input:
; DFN - IEN in the PATIENT file.
; YEAR - value for the INCOME YEAR field, a year in FM format.
;Output:
; Function Value - returns IEN of record if found, NULL otherwise.
;
Q:('$G(DFN)!'$G(YEAR)) ""
;
N YR
S YR=$E(YEAR,1,3)_"0000"
Q $O(^IVM(301.5,"APT",DFN,YR,0))
;
LOCK(IEN) ;
;Description: Locks a record in the IVM PATIENT file.
;Input:
; IEN - ien of record in IVM PATIENT file.
;Output:
; Function Value - 1 if successful, 0 otherwise.
;
I $G(IEN) L +^IVM(301.5,IEN):3
Q $T
;
UNLOCK(IEN) ;
;Description: Unlocks a record in the IVM PATIENT file.
;Input:
; IEN - ien of record in the IVM PATIENT file.
;Output: None
;
I $G(IEN) L -^IVM(301.5,IEN)
Q
;
STATUS(IEN,EVENTS) ;
;Description: Returns the value of the TRANSMISSION STATUS field of the
; IVM PATIENT file.
;
;Input:
; IEN - internal entry number of a record in the IVM PATIENT file
;Output:
; Function Value -returns the value of the TRANSMISSION STATUS field
; EVENTS - optional, pass by reference. Will return the types of events logged.
; EVENTS("IVM") - value of IVM EVENT field
; EVENTS("DCD") - value of DCD EVENT field
; EVENTS("ENROLL") - value of ENROLLMENT EVENT field
;
;
S EVENTS("IVM")=""
S EVENTS("DCD")=""
S EVENTS("ENROLL")=""
;
Q:'$G(IEN) ""
;
N NODE
S NODE=$G(^IVM(301.5,IEN,"E"))
S EVENTS("IVM")=$P(NODE,"^")
S EVENTS("DCD")=$P(NODE,"^",2)
S EVENTS("ENROLL")=$P(NODE,"^",3)
Q $P($G(^IVM(301.5,IEN,0)),"^",3)
;
SETSTAT(IEN,EVENTS,ERRMSG) ;
;Description: Sets the value of the TRANSMISSION STATUS field of the
; IVM PATIENT file for a particular record to 0, meaning transmission
; is requested. If the case is closed, depending on the event types,
; the TRANSMISSION STATUS may not be set.
;Input:
; IEN - internal entry number of a record in the IVM PATIENT file.
; EVENTS () - an array of reasons for transmission, pass by reference.
; EVENTS("IVM") = 1 if transmission due to IVM criteria, 0 otherwise
; EVENTS("DCD")=1 if transmission due to DCD criteria, 0 otherwise
; EVENTS("ENROLL")=1 if transmission due to enrollment criteria, 0 otherwise
;Output:
; Function Value - 1 on success, 0 on failure.
; ERRMSG - optional, pass by reference if needed, returns message on failure
;
N DATA,CLOSED,SUCCESS
;
I ($G(DGENUPLD)="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS") S ERRMSG="ENROLLMENT UPLOAD IN PROGRESS" Q 0
;
I '$$LOCK($G(IEN)) S ERRMSG="UNABLE TO OBTAIN LOCK ON IVM PATIENT, TRY AGAIN LATTER" Q 0
S CLOSED=$$CLOSED(IEN)
S SUCCESS=0
I ('CLOSED)!(1=$G(EVENTS("ENROLL"))) D
.S DATA(.03)=0
.I 'CLOSED D
..I $G(EVENTS("IVM"))=1 S DATA(30.01)=1
..I $G(EVENTS("DCD"))=1 S DATA(30.02)=1
.I $G(EVENTS("ENROLL"))=1 S DATA(30.03)=1
.S SUCCESS=$$UPD^DGENDBS(301.5,IEN,.DATA,.ERRMSG)
E S SUCCESS=0,ERRMSG="CASE IS CLOSED"
D UNLOCK(IEN)
Q SUCCESS
;
CLEAR(IEN,WHEN) ;
; Description: Sets the value of the TRANSMISSION STATUS field of the
;IVM PATIENT file for a particular record to 1, meaning transmission
;already occurred.
;
;Input:
; IEN - internal entry number of record in IVM PATIENT file
; WHEN - optional, date/time in FM format that transmission occurred
;Output:
; Function Value - 1 on success, 0 on failure
;
N SUCCESS,PLOG,DATA
Q:'$$LOCK($G(IEN)) 0
Q:'$$GET(IEN,.PLOG) 0
S DATA(.03)=1
I PLOG("EVENTS","IVM")=1 S DATA(30.01)=2
I PLOG("EVENTS","DCD")=1 S DATA(30.02)=2
I PLOG("EVENTS","ENROLL")=1 S DATA(30.03)=2
I $G(WHEN),((PLOG("FIRST")'>0)!(WHEN<PLOG("FIRST"))) S DATA(.05)=WHEN
S SUCCESS=$$UPD^DGENDBS(301.5,IEN,.DATA)
D UNLOCK(IEN)
Q SUCCESS
;
GET(IEN,PLOG) ;
;Description: Used to obtain a record in the IVM PATIENT file. The
;values are returned in the PLOG() array.
;Input:
; IEN - internal entry number of a record in the IVM PATIENT file.
;Output:
; Function Value - 1 on success, 0 on failure.
; PLOG() array, pass by reference. Subscripts are
; "DFN" - value of the PATIENT field (#.01) which is the ien of record in the PATIENT file.
; "YEAR" - value of the INCOME YEAR field (#.02)
; "STATUS" - value from the TRANSMISSIONS STATUS field (#.03)
; "FIRST" - value from the QUERY TRANSMISSION DATE/TIME field (#.05)
; "CLOSE" - value from the STOP FLAG field (#.04)
; "CLOSE","REASON" - value from the CLOSURE REASON field (#301.93)
; "CLOSE","SOURCE" - value of the CLOSURE SOURCE field (#1.02)
; "CLOSE","TIME" - value of the CLOSURE DATE/TIME field (#1.03)
; "EVENTS","IVM" - value of the IVM EVENT field
; "EVENTS","DCD" - value of the DCD EVENT field
; "EVENTS","ENROLL" - value of the ENROLLMENT EVENT field
;
N NODE
Q:'$G(IEN) 0
S NODE=$G(^IVM(301.5,IEN,0))
Q:(NODE="") 0
S PLOG("DFN")=$P(NODE,"^")
S PLOG("YEAR")=$P(NODE,"^",2)
S PLOG("STATUS")=$P(NODE,"^",3)
S PLOG("FIRST")=$P(NODE,"^",5)
S PLOG("CLOSE")=$P(NODE,"^",4)
S NODE=$G(^IVM(301.5,IEN,1))
S PLOG("CLOSE","REASON")=$P(NODE,"^")
S PLOG("CLOSE","SOURCE")=$P(NODE,"^",2)
S PLOG("CLOSE","TIME")=$P(NODE,"^",3)
S NODE=$G(^IVM(301.5,IEN,"E"))
S PLOG("EVENTS","IVM")=$P(NODE,"^")
S PLOG("EVENTS","DCD")=$P(NODE,"^",2)
S PLOG("EVENTS","ENROLL")=$P(NODE,"^",3)
Q 1
;
CLOSED(IEN) ;
;Description: Returns the value of the STOP FLAG field of the
;IVM PATIENT file for a particular record, which indicates whether
;transmissions for certain events (but not enrollment events) should
;take place.
;
;Input:
; IEN - internal entry number of a record in the IVM PATIENT file.
;Output:
; Function Value - The value of the STOP FLAG field.
;
Q:'$G(IEN) ""
Q $P($G(^IVM(301.5,IEN,0)),"^",4)
;
LOG(DFN,YEAR,EVENTS) ;
;Description: Used to queue a patient for the nightly full transmission
;for a particular income year. If EVENTS is not passed, an entry in the
;IVM PATIENT file will be created if it does not already exist, but
;the flag for transmission will not be set.
;
;Input:
; DFN - ien of record in the PATIENT file.
; YEAR - income year in FM format. This is the year that is to be
; used when creating the full transmission message.
; EVENTS () - an array of reasons for transmission, pass by reference.
; EVENTS("IVM") = 1 if transmission due to IVM criteria, 0 otherwise
; EVENTS(" "DCD")=1 if transmission due to DCD criteria, 0 otherwise
; EVENTS("ENROLL")=1 if transmission due to enrollment criteria, 0 otherwise
;Output:
; Function Value - internal entry number of the IVM PATIENT file record, or NULL if record could not be found or created.
;
N IEN
;
;if the eligibility/enrollment upload is in progess, do nothing
Q:($G(DGENUPLD)="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS") ""
;
;to be compatable with current software - in some places,
;YEAR passed is just 3 digits
S:YEAR YEAR=$E(YEAR,1,3)_"0000"
;
Q:'$$TESTVAL^DGENDBS(301.5,.01,DFN) ""
Q:'$$TESTVAL^DGENDBS(301.5,.02,YEAR) ""
;
; check for an existing record in 301.5 for this income year...
S IEN=$$FIND(DFN,YEAR)
I 'IEN D
.;need to create a new record
.N DATA
.L +^IVM(301.5,0):3
.Q:'$T
.S IEN=$$FIND(DFN,YEAR)
.I IEN L -^IVM(301.5,0) Q
.S DATA(.01)=DFN,DATA(.02)=YEAR,DATA(.04)=1,DATA(1.01)=5,DATA(1.02)=2,DATA(1.03)=$$NOW^XLFDT
.S IEN=$$ADD^DGENDBS(301.5,,.DATA)
.L -^IVM(301.5,0)
I IEN,$D(EVENTS),$$SETSTAT(IEN,.EVENTS)
Q IEN
;
DELETE(DFN,TESTDATE,MT,RX,HARDSHIP,LTC) ;
;Description: Used to notify HEC that deletion of a MT,RX Copay test,
;LTC copay exemption test or hardship has occurred
;
;Input:
; DFN - ien of record in the PATIENT file.
; TESTDATE - date of test
; MT - if $D(MT),MT then a MT was deleted
; RX - if $D(RX),RX then a RX copay test was deleted
; HARDSHIP - if $D(HARDSHIP),HARDSHIP then a hardship was deleted
; LTC - if $G(LTC) then a LTC copay exemption test was deleted
;Output: none
;
N YEAR,IEN,DATA
;
S YEAR=($E(TESTDATE,1,3)-1)_"0000"
;
;
S IEN=$$FIND(DFN,YEAR)
Q:'IEN
I $D(HARDSHIP),HARDSHIP S DATA(.1)=TESTDATE
I $D(MT),MT S DATA(.08)=TESTDATE
I $D(RX),RX S DATA(.09)=TESTDATE
I $G(LTC) S DATA(.11)=TESTDATE
I $$UPD^DGENDBS(301.5,IEN,.DATA)
Q
;
EVENT(DFN) ;
;Description: Called in response to enrollment events. Determines
;whether for this patient transmission is appropriate, and if so the
;patient is logged for transmission.
;
;Input: DFN
;Output: none
;
Q:'$G(DFN)
;
Q:'$$ON^IVMUPAR1 ;quit if enrollment events turned off
;
;don't want to log event if called due to file re-indexing
I $D(DIU(0))!($D(DIK)&$D(DIKJ)&$D(DIKLK)&$D(DIKS)&$D(DIN)) Q
;
;if the eligibility/enrollment upload is in progess, or there is no enrollment, do nothing
Q:($G(DGENUPLD)="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS")
;remove screen for non-vets, IVM 115 - ERC
I '$$VET1^DGENPTA(DFN) S EVENTS("ENROLL")=1 I $$LOG(DFN,$$YEAR(DFN),.EVENTS) Q
I ('$$FINDCUR^DGENA(DFN)),('$$VET^DGENPTA(DFN)) Q
N STATUS
S STATUS=$$STATUS^DGENA(DFN)
; Purple Heart added status 21
; IVM*2.0*194 - KUM - Add Status 25 (Registration only)
I $$VET1^DGENPTA(DFN)!(STATUS=1)!(STATUS=2)!(STATUS=9)!(STATUS=15)!(STATUS=16)!(STATUS=17)!(STATUS=18)!(STATUS=19)!(STATUS=20)!(STATUS=21)!(STATUS=23)!(STATUS=25) D
.N EVENTS
.S EVENTS("ENROLL")=1
.I $$LOG(DFN,$$YEAR(DFN),.EVENTS) ;no need to inform on success or failure
Q
;
YEAR(DFN) ;
;Determines the income year to be used in the transmission
;
N YEAR
S YEAR=$$LD^IVMUFNC4(DFN)
S:YEAR YEAR=($E(YEAR,1,3)-1)_"0000"
S:'YEAR YEAR=($E(DT,1,3)-1)_"0000"
Q YEAR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMPLOG 9985 printed Dec 13, 2024@02:02:10 Page 2
IVMPLOG ;ALB/CJM,RTK,ERC,KUM - API for IVM PATIENT file; ; 8/15/08 12:49pm
+1 ;;2.0;INCOME VERIFICATION MATCH;**9,19,12,21,17,28,36,40,49,68,115,194**; 21-OCT-94;Build 34
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;
FIND(DFN,YEAR) ;
+1 ;Description: Looks up an entry in the IVM PATIENT file (#301.5).
+2 ;Input:
+3 ; DFN - IEN in the PATIENT file.
+4 ; YEAR - value for the INCOME YEAR field, a year in FM format.
+5 ;Output:
+6 ; Function Value - returns IEN of record if found, NULL otherwise.
+7 ;
+8 if ('$GET(DFN)!'$GET(YEAR))
QUIT ""
+9 ;
+10 NEW YR
+11 SET YR=$EXTRACT(YEAR,1,3)_"0000"
+12 QUIT $ORDER(^IVM(301.5,"APT",DFN,YR,0))
+13 ;
LOCK(IEN) ;
+1 ;Description: Locks a record in the IVM PATIENT file.
+2 ;Input:
+3 ; IEN - ien of record in IVM PATIENT file.
+4 ;Output:
+5 ; Function Value - 1 if successful, 0 otherwise.
+6 ;
+7 IF $GET(IEN)
LOCK +^IVM(301.5,IEN):3
+8 QUIT $TEST
+9 ;
UNLOCK(IEN) ;
+1 ;Description: Unlocks a record in the IVM PATIENT file.
+2 ;Input:
+3 ; IEN - ien of record in the IVM PATIENT file.
+4 ;Output: None
+5 ;
+6 IF $GET(IEN)
LOCK -^IVM(301.5,IEN)
+7 QUIT
+8 ;
STATUS(IEN,EVENTS) ;
+1 ;Description: Returns the value of the TRANSMISSION STATUS field of the
+2 ; IVM PATIENT file.
+3 ;
+4 ;Input:
+5 ; IEN - internal entry number of a record in the IVM PATIENT file
+6 ;Output:
+7 ; Function Value -returns the value of the TRANSMISSION STATUS field
+8 ; EVENTS - optional, pass by reference. Will return the types of events logged.
+9 ; EVENTS("IVM") - value of IVM EVENT field
+10 ; EVENTS("DCD") - value of DCD EVENT field
+11 ; EVENTS("ENROLL") - value of ENROLLMENT EVENT field
+12 ;
+13 ;
+14 SET EVENTS("IVM")=""
+15 SET EVENTS("DCD")=""
+16 SET EVENTS("ENROLL")=""
+17 ;
+18 if '$GET(IEN)
QUIT ""
+19 ;
+20 NEW NODE
+21 SET NODE=$GET(^IVM(301.5,IEN,"E"))
+22 SET EVENTS("IVM")=$PIECE(NODE,"^")
+23 SET EVENTS("DCD")=$PIECE(NODE,"^",2)
+24 SET EVENTS("ENROLL")=$PIECE(NODE,"^",3)
+25 QUIT $PIECE($GET(^IVM(301.5,IEN,0)),"^",3)
+26 ;
SETSTAT(IEN,EVENTS,ERRMSG) ;
+1 ;Description: Sets the value of the TRANSMISSION STATUS field of the
+2 ; IVM PATIENT file for a particular record to 0, meaning transmission
+3 ; is requested. If the case is closed, depending on the event types,
+4 ; the TRANSMISSION STATUS may not be set.
+5 ;Input:
+6 ; IEN - internal entry number of a record in the IVM PATIENT file.
+7 ; EVENTS () - an array of reasons for transmission, pass by reference.
+8 ; EVENTS("IVM") = 1 if transmission due to IVM criteria, 0 otherwise
+9 ; EVENTS("DCD")=1 if transmission due to DCD criteria, 0 otherwise
+10 ; EVENTS("ENROLL")=1 if transmission due to enrollment criteria, 0 otherwise
+11 ;Output:
+12 ; Function Value - 1 on success, 0 on failure.
+13 ; ERRMSG - optional, pass by reference if needed, returns message on failure
+14 ;
+15 NEW DATA,CLOSED,SUCCESS
+16 ;
+17 IF ($GET(DGENUPLD)="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS")
SET ERRMSG="ENROLLMENT UPLOAD IN PROGRESS"
QUIT 0
+18 ;
+19 IF '$$LOCK($GET(IEN))
SET ERRMSG="UNABLE TO OBTAIN LOCK ON IVM PATIENT, TRY AGAIN LATTER"
QUIT 0
+20 SET CLOSED=$$CLOSED(IEN)
+21 SET SUCCESS=0
+22 IF ('CLOSED)!(1=$GET(EVENTS("ENROLL")))
Begin DoDot:1
+23 SET DATA(.03)=0
+24 IF 'CLOSED
Begin DoDot:2
+25 IF $GET(EVENTS("IVM"))=1
SET DATA(30.01)=1
+26 IF $GET(EVENTS("DCD"))=1
SET DATA(30.02)=1
End DoDot:2
+27 IF $GET(EVENTS("ENROLL"))=1
SET DATA(30.03)=1
+28 SET SUCCESS=$$UPD^DGENDBS(301.5,IEN,.DATA,.ERRMSG)
End DoDot:1
+29 IF '$TEST
SET SUCCESS=0
SET ERRMSG="CASE IS CLOSED"
+30 DO UNLOCK(IEN)
+31 QUIT SUCCESS
+32 ;
CLEAR(IEN,WHEN) ;
+1 ; Description: Sets the value of the TRANSMISSION STATUS field of the
+2 ;IVM PATIENT file for a particular record to 1, meaning transmission
+3 ;already occurred.
+4 ;
+5 ;Input:
+6 ; IEN - internal entry number of record in IVM PATIENT file
+7 ; WHEN - optional, date/time in FM format that transmission occurred
+8 ;Output:
+9 ; Function Value - 1 on success, 0 on failure
+10 ;
+11 NEW SUCCESS,PLOG,DATA
+12 if '$$LOCK($GET(IEN))
QUIT 0
+13 if '$$GET(IEN,.PLOG)
QUIT 0
+14 SET DATA(.03)=1
+15 IF PLOG("EVENTS","IVM")=1
SET DATA(30.01)=2
+16 IF PLOG("EVENTS","DCD")=1
SET DATA(30.02)=2
+17 IF PLOG("EVENTS","ENROLL")=1
SET DATA(30.03)=2
+18 IF $GET(WHEN)
IF ((PLOG("FIRST")'>0)!(WHEN<PLOG("FIRST")))
SET DATA(.05)=WHEN
+19 SET SUCCESS=$$UPD^DGENDBS(301.5,IEN,.DATA)
+20 DO UNLOCK(IEN)
+21 QUIT SUCCESS
+22 ;
GET(IEN,PLOG) ;
+1 ;Description: Used to obtain a record in the IVM PATIENT file. The
+2 ;values are returned in the PLOG() array.
+3 ;Input:
+4 ; IEN - internal entry number of a record in the IVM PATIENT file.
+5 ;Output:
+6 ; Function Value - 1 on success, 0 on failure.
+7 ; PLOG() array, pass by reference. Subscripts are
+8 ; "DFN" - value of the PATIENT field (#.01) which is the ien of record in the PATIENT file.
+9 ; "YEAR" - value of the INCOME YEAR field (#.02)
+10 ; "STATUS" - value from the TRANSMISSIONS STATUS field (#.03)
+11 ; "FIRST" - value from the QUERY TRANSMISSION DATE/TIME field (#.05)
+12 ; "CLOSE" - value from the STOP FLAG field (#.04)
+13 ; "CLOSE","REASON" - value from the CLOSURE REASON field (#301.93)
+14 ; "CLOSE","SOURCE" - value of the CLOSURE SOURCE field (#1.02)
+15 ; "CLOSE","TIME" - value of the CLOSURE DATE/TIME field (#1.03)
+16 ; "EVENTS","IVM" - value of the IVM EVENT field
+17 ; "EVENTS","DCD" - value of the DCD EVENT field
+18 ; "EVENTS","ENROLL" - value of the ENROLLMENT EVENT field
+19 ;
+20 NEW NODE
+21 if '$GET(IEN)
QUIT 0
+22 SET NODE=$GET(^IVM(301.5,IEN,0))
+23 if (NODE="")
QUIT 0
+24 SET PLOG("DFN")=$PIECE(NODE,"^")
+25 SET PLOG("YEAR")=$PIECE(NODE,"^",2)
+26 SET PLOG("STATUS")=$PIECE(NODE,"^",3)
+27 SET PLOG("FIRST")=$PIECE(NODE,"^",5)
+28 SET PLOG("CLOSE")=$PIECE(NODE,"^",4)
+29 SET NODE=$GET(^IVM(301.5,IEN,1))
+30 SET PLOG("CLOSE","REASON")=$PIECE(NODE,"^")
+31 SET PLOG("CLOSE","SOURCE")=$PIECE(NODE,"^",2)
+32 SET PLOG("CLOSE","TIME")=$PIECE(NODE,"^",3)
+33 SET NODE=$GET(^IVM(301.5,IEN,"E"))
+34 SET PLOG("EVENTS","IVM")=$PIECE(NODE,"^")
+35 SET PLOG("EVENTS","DCD")=$PIECE(NODE,"^",2)
+36 SET PLOG("EVENTS","ENROLL")=$PIECE(NODE,"^",3)
+37 QUIT 1
+38 ;
CLOSED(IEN) ;
+1 ;Description: Returns the value of the STOP FLAG field of the
+2 ;IVM PATIENT file for a particular record, which indicates whether
+3 ;transmissions for certain events (but not enrollment events) should
+4 ;take place.
+5 ;
+6 ;Input:
+7 ; IEN - internal entry number of a record in the IVM PATIENT file.
+8 ;Output:
+9 ; Function Value - The value of the STOP FLAG field.
+10 ;
+11 if '$GET(IEN)
QUIT ""
+12 QUIT $PIECE($GET(^IVM(301.5,IEN,0)),"^",4)
+13 ;
LOG(DFN,YEAR,EVENTS) ;
+1 ;Description: Used to queue a patient for the nightly full transmission
+2 ;for a particular income year. If EVENTS is not passed, an entry in the
+3 ;IVM PATIENT file will be created if it does not already exist, but
+4 ;the flag for transmission will not be set.
+5 ;
+6 ;Input:
+7 ; DFN - ien of record in the PATIENT file.
+8 ; YEAR - income year in FM format. This is the year that is to be
+9 ; used when creating the full transmission message.
+10 ; EVENTS () - an array of reasons for transmission, pass by reference.
+11 ; EVENTS("IVM") = 1 if transmission due to IVM criteria, 0 otherwise
+12 ; EVENTS(" "DCD")=1 if transmission due to DCD criteria, 0 otherwise
+13 ; EVENTS("ENROLL")=1 if transmission due to enrollment criteria, 0 otherwise
+14 ;Output:
+15 ; Function Value - internal entry number of the IVM PATIENT file record, or NULL if record could not be found or created.
+16 ;
+17 NEW IEN
+18 ;
+19 ;if the eligibility/enrollment upload is in progess, do nothing
+20 if ($GET(DGENUPLD)="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS")
QUIT ""
+21 ;
+22 ;to be compatable with current software - in some places,
+23 ;YEAR passed is just 3 digits
+24 if YEAR
SET YEAR=$EXTRACT(YEAR,1,3)_"0000"
+25 ;
+26 if '$$TESTVAL^DGENDBS(301.5,.01,DFN)
QUIT ""
+27 if '$$TESTVAL^DGENDBS(301.5,.02,YEAR)
QUIT ""
+28 ;
+29 ; check for an existing record in 301.5 for this income year...
+30 SET IEN=$$FIND(DFN,YEAR)
+31 IF 'IEN
Begin DoDot:1
+32 ;need to create a new record
+33 NEW DATA
+34 LOCK +^IVM(301.5,0):3
+35 if '$TEST
QUIT
+36 SET IEN=$$FIND(DFN,YEAR)
+37 IF IEN
LOCK -^IVM(301.5,0)
QUIT
+38 SET DATA(.01)=DFN
SET DATA(.02)=YEAR
SET DATA(.04)=1
SET DATA(1.01)=5
SET DATA(1.02)=2
SET DATA(1.03)=$$NOW^XLFDT
+39 SET IEN=$$ADD^DGENDBS(301.5,,.DATA)
+40 LOCK -^IVM(301.5,0)
End DoDot:1
+41 IF IEN
IF $DATA(EVENTS)
IF $$SETSTAT(IEN,.EVENTS)
+42 QUIT IEN
+43 ;
DELETE(DFN,TESTDATE,MT,RX,HARDSHIP,LTC) ;
+1 ;Description: Used to notify HEC that deletion of a MT,RX Copay test,
+2 ;LTC copay exemption test or hardship has occurred
+3 ;
+4 ;Input:
+5 ; DFN - ien of record in the PATIENT file.
+6 ; TESTDATE - date of test
+7 ; MT - if $D(MT),MT then a MT was deleted
+8 ; RX - if $D(RX),RX then a RX copay test was deleted
+9 ; HARDSHIP - if $D(HARDSHIP),HARDSHIP then a hardship was deleted
+10 ; LTC - if $G(LTC) then a LTC copay exemption test was deleted
+11 ;Output: none
+12 ;
+13 NEW YEAR,IEN,DATA
+14 ;
+15 SET YEAR=($EXTRACT(TESTDATE,1,3)-1)_"0000"
+16 ;
+17 ;
+18 SET IEN=$$FIND(DFN,YEAR)
+19 if 'IEN
QUIT
+20 IF $DATA(HARDSHIP)
IF HARDSHIP
SET DATA(.1)=TESTDATE
+21 IF $DATA(MT)
IF MT
SET DATA(.08)=TESTDATE
+22 IF $DATA(RX)
IF RX
SET DATA(.09)=TESTDATE
+23 IF $GET(LTC)
SET DATA(.11)=TESTDATE
+24 IF $$UPD^DGENDBS(301.5,IEN,.DATA)
+25 QUIT
+26 ;
EVENT(DFN) ;
+1 ;Description: Called in response to enrollment events. Determines
+2 ;whether for this patient transmission is appropriate, and if so the
+3 ;patient is logged for transmission.
+4 ;
+5 ;Input: DFN
+6 ;Output: none
+7 ;
+8 if '$GET(DFN)
QUIT
+9 ;
+10 ;quit if enrollment events turned off
if '$$ON^IVMUPAR1
QUIT
+11 ;
+12 ;don't want to log event if called due to file re-indexing
+13 IF $DATA(DIU(0))!($DATA(DIK)&$DATA(DIKJ)&$DATA(DIKLK)&$DATA(DIKS)&$DATA(DIN))
QUIT
+14 ;
+15 ;if the eligibility/enrollment upload is in progess, or there is no enrollment, do nothing
+16 if ($GET(DGENUPLD)="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS")
QUIT
+17 ;remove screen for non-vets, IVM 115 - ERC
+18 IF '$$VET1^DGENPTA(DFN)
SET EVENTS("ENROLL")=1
IF $$LOG(DFN,$$YEAR(DFN),.EVENTS)
QUIT
+19 IF ('$$FINDCUR^DGENA(DFN))
IF ('$$VET^DGENPTA(DFN))
QUIT
+20 NEW STATUS
+21 SET STATUS=$$STATUS^DGENA(DFN)
+22 ; Purple Heart added status 21
+23 ; IVM*2.0*194 - KUM - Add Status 25 (Registration only)
+24 IF $$VET1^DGENPTA(DFN)!(STATUS=1)!(STATUS=2)!(STATUS=9)!(STATUS=15)!(STATUS=16)!(STATUS=17)!(STATUS=18)!(STATUS=19)!(STATUS=20)!(STATUS=21)!(STATUS=23)!(STATUS=25)
Begin DoDot:1
+25 NEW EVENTS
+26 SET EVENTS("ENROLL")=1
+27 ;no need to inform on success or failure
IF $$LOG(DFN,$$YEAR(DFN),.EVENTS)
End DoDot:1
+28 QUIT
+29 ;
YEAR(DFN) ;
+1 ;Determines the income year to be used in the transmission
+2 ;
+3 NEW YEAR
+4 SET YEAR=$$LD^IVMUFNC4(DFN)
+5 if YEAR
SET YEAR=($EXTRACT(YEAR,1,3)-1)_"0000"
+6 if 'YEAR
SET YEAR=($EXTRACT(DT,1,3)-1)_"0000"
+7 QUIT YEAR
