135 lines
4.5 KiB
Mathematica
135 lines
4.5 KiB
Mathematica
DGENA2 ;ALB/CJM,RTK,TDM - Enrollment API - Automatic Update; 9/19/2002 ; 1/31/03 11:54am
|
|
;;5.3;Registration;**121,122,147,232,327,469,491**;Aug 13,1993
|
|
;
|
|
AUTOUPD(DFN,EVENT) ;
|
|
;Description: If the patient meets the criteria for transmission to HEC,
|
|
; he is entered to the IVM PATIENT file for future transmission.
|
|
; This procedure checks for changes in enrollment priority,
|
|
; status and fields in the eligibility sub-record. If any changes are
|
|
; found, the current enrollment record is automatically updated.
|
|
;Input:
|
|
; DFN - Patient IEN
|
|
; EVENT - Event Type (optional)
|
|
; EVENT 1 : Date of Death Deleted
|
|
; EVENT 2 : Ineligible Date Deleted
|
|
;Output: None
|
|
;
|
|
;if the eligibility/enrollment upload is in progess, do not do anything
|
|
Q:($G(DGENUPLD)="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS")
|
|
;
|
|
; If the INCOME TEST DATA (Z10) upload is in progess, do not do anything
|
|
Q:($G(IVMZ10)="UPLOAD IN PROGRESS")
|
|
;
|
|
N DGENRIEN,DGENR1,DGENR2,STATUS,EFFDATE,OK,DEATH
|
|
;
|
|
;try to prevent problems rsulting from calling FM within FM
|
|
N DS,D0,DO,D1,DA,DD,DS,DG,DIC,DICR,DIE,DIG,DIH,DIV,DIW,DIX,DQ,DR
|
|
;
|
|
S EVENT=+$G(EVENT)
|
|
;
|
|
D EVENT^IVMPLOG(DFN)
|
|
;
|
|
D:$$LOCK^DGENA1($G(DFN)) ;may drop out of block
|
|
.S DGENRIEN=$$FINDCUR^DGENA(DFN)
|
|
.Q:'DGENRIEN
|
|
.Q:'$$GET^DGENA(DGENRIEN,.DGENR1)
|
|
.S STATUS=$$EXT^DGENU("STATUS",DGENR1("STATUS"))
|
|
.S (DEATH,EFFDATE)=$$DEATH^DGENPTA(DFN)
|
|
.I STATUS'="VERIFIED",STATUS'="UNVERIFIED",STATUS'="DECEASED",STATUS'["NOT ELIGIBLE",STATUS'["PENDING",STATUS'["REJECTED" Q
|
|
.I STATUS="DECEASED",((EVENT'=1)!(DEATH)) Q
|
|
.I STATUS["NOT ELIGIBLE",((EVENT'=2)!('$$VET^DGENPTA(DFN))) Q
|
|
.S:'EFFDATE EFFDATE=DT
|
|
.Q:'$$CREATE^DGENA6(DFN,DGENR1("APP"),EFFDATE,DGENR1("REASON"),DGENR1("REMARKS"),.DGENR2,DGENR1("DATE"),DGENR1("END"))
|
|
.S OK=1
|
|
.S:(DGENR1("PRIORITY")'=DGENR2("PRIORITY"))!(DGENR2("STATUS")'=DGENR1("STATUS")) OK=0
|
|
.I OK D
|
|
..N SUB
|
|
..S SUB=""
|
|
..F S SUB=$O(DGENR2("ELIG",SUB)) Q:SUB="" S:(DGENR1("ELIG",SUB)'=DGENR2("ELIG",SUB)) OK=0
|
|
.I 'OK D
|
|
..I (DGENR1("EFFDATE")=DGENR2("EFFDATE")),(DGENR1("SOURCE")=DGENR2("SOURCE")),(DGENR1("USER")=DGENR2("USER")),(DGENR1("DATETIME")\1)=(DGENR2("DATETIME")\1) D
|
|
...;in this case it's an overlay
|
|
...S DGENR2("PRIORREC")=DGENR1("PRIORREC")
|
|
...I $$EDITCUR^DGENA1(.DGENR2)
|
|
..E D
|
|
...;in this case create a new record, to preserve the audit trail
|
|
...I $$STORECUR^DGENA1(.DGENR2)
|
|
D UNLOCK^DGENA1($G(DFN))
|
|
Q
|
|
MTUPD ;
|
|
;Description - entry point for Means Test Event Driver for Enrollment
|
|
;
|
|
D AUTOUPD($G(DFN))
|
|
Q
|
|
;
|
|
SDDIS ;Entry point for the DGEN SD DISPLAY CURRENT ENROLLMENT protocol,
|
|
;which hangs of the Scheduling Event Driver
|
|
;
|
|
N DFN S DFN=$P($G(SDATA),"^",2)
|
|
;
|
|
;don't display if running in the background
|
|
Q:$D(ZTQUEUED)
|
|
;
|
|
;don't want to display enrollment for non-vets with no enrollment status
|
|
Q:('$$VET^DGENPTA(DFN))&('$$STATUS^DGENA(DFN))
|
|
;
|
|
;if making an appt., & in interactive mode, display enrollment status
|
|
I ($G(SDAMEVT)=1),$G(SDMODE)=0 D
|
|
.D DISPLAY^DGENU($P($G(SDATA),"^",2))
|
|
.D PAUSE^VALM1
|
|
;
|
|
;want to do the same thing for check-in, unless appt just made
|
|
I ($G(SDAMEVT)=4),$G(SDMODE)=0 D
|
|
.;want to try avoiding giving display if it was done already
|
|
.;so, if it is an unscheduled appt made today, skip
|
|
.N PTNODE,SCNODE
|
|
.S SCNODE=$G(^TMP("SDAMEVT",$J,"AFTER","SC"))
|
|
.S PTNODE=$G(^TMP("SDAMEVT",$J,"AFTER","DPT"))
|
|
.I +$P(SCNODE,"^",7)=$G(DT),$P(PTNODE,"^",7)=4 Q ;unscheduled appt made today
|
|
.D DISPLAY^DGENU($P($G(SDATA),"^",2))
|
|
.D PAUSE^VALM1
|
|
Q
|
|
;
|
|
ENROLL ;Entry point for the DGEN SD ENROLL PATIENT protocol, which hangs of
|
|
;the Scheduling Event Driver. This event enrolls patients upon check-out
|
|
;if there is no prior enrollment record.
|
|
;
|
|
; Input -- SDATA & SDAMEVT defined by the scheduling event driver
|
|
; Output -- none
|
|
;
|
|
N DGENR,DFN
|
|
;
|
|
;NOTE - it appears from testing that means test status REQUIRED is set
|
|
;within scheduling, obviating the need to do it here. This is why
|
|
;several lines are commented out.
|
|
;
|
|
;N DGENR,DGOKF,DGREQF,DFN,DGMSGF,DG,DGMT,DGMTCOR,DGMTE,DGRGAUTO,DGWRT,XMZ,DIG,DIH
|
|
;
|
|
;check-out?
|
|
Q:($G(SDAMEVT)'=5)
|
|
;
|
|
S DFN=$P($G(SDATA),"^",2)
|
|
;
|
|
;don't enroll if the patient has an enrollment record
|
|
Q:$$FINDCUR^DGENA(DFN)
|
|
;
|
|
;non-vet?
|
|
Q:'$$VET^DGENPTA(DFN)
|
|
;
|
|
;dead?
|
|
Q:$$DEATH^DGENPTA(DFN)
|
|
;
|
|
;Does patient require a Means Test?
|
|
;S DGMSGF=1
|
|
;D EN^DGMTR
|
|
;
|
|
;Create local enrollment array
|
|
I $$CREATE^DGENA6(DFN,DT,,,,.DGENR) D
|
|
. ;
|
|
. ;Store local enrollment as current
|
|
. I $$STORECUR^DGENA1(.DGENR) D
|
|
. . ;
|
|
. . ;If patient's means test status is required, send bulletin
|
|
. . ;I $$MTREQ^DGEN(DFN) D MTBULL^DGEN(DFN,.DGENR)
|
|
Q
|