281 lines
9.2 KiB
Mathematica
281 lines
9.2 KiB
Mathematica
IVMPLOG ;ALB/CJM,RTK - API for IVM PATIENT file; ; 12/6/00 5:28pm
|
|
;;2.0;INCOME VERIFICATION MATCH;**9,19,12,21,17,28,36,40,49,68**; 21-OCT-94
|
|
;;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")
|
|
I ('$$FINDCUR^DGENA(DFN)),('$$VET^DGENPTA(DFN)) Q
|
|
N STATUS
|
|
S STATUS=$$STATUS^DGENA(DFN)
|
|
; Purple Heart added status 21
|
|
I $$VET1^DGENPTA(DFN)!(STATUS=1)!(STATUS=2)!(STATUS=9)!(STATUS=15)!(STATUS=16)!(STATUS=17)!(STATUS=18)!(STATUS=19)!(STATUS=20)!(STATUS=21) 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
|