EASMTCHK ;ALB/SCK,PJR,BDB - MEANS TEST BLOCKING CHECK ; 11/13/03 11:13am
;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,12,15,38,46,106**;MAR 15,2001;Build 28
; This routine provides an API, which when called from Appointment Management will allow
; for the blocking of future appointments and appointment check-in/out if the patient
; requires a Means Test or has a Means Test Status of Required. $$LST^DGMTU is used
; to determine if a MT is REQUIRED. If a MT does not have a status of REQUIRED,
; but is more than 365 days out (same criteria used in OLD^DGMTU4), the MT will
; be considered "REQUIRED" for blocking purposes. If a Means Test is required, the
; following combinations of appointment actions will be blocked:
; o Making a future appt for a Regular appt type
; o Check In/Out an appt which is either a Regular or Research type
;
; A Walk-in will see the alert notice, and will be warned NOT to CHECK-IN the walk-in
; appointment. Unscheduled/Walk-ins can ONLY be checked out.
;
; This API may be passed a flag to "silence" the screen display of the alert message, and
; will accept an array variable to return the alert text in. Inpatient appointments
; are not affected in any way. Domicilary are not considered inpatients for the purpose
; of Means Test Blocking for appointments
;
MT(DFN,EASAPT,EASACT,EASDT,EASQT,EASMSG) ; Entry point for MT Check
; Input Variables
; DFN - Patient's IEN in File #2
; EASAPT - Appointment Type (File #409.1) [Optional]
; EASACT - Appointment Action Flag [Optional] Default = "Other"
; "M" - Make an Appointment
; "C" - Check In/Out an existing appointment
; "W" - Unscheduled/Walk-in appointment
; "O" - Other
; "L" - Letters
;
; EASDT - Appointment Date/Time [Optional]
; EASQT - Silent flag [Optional], if set will prevent display of alert message
; EASMSG - Return array for alert message [Optional], if passed in, the alert
; message text will be copied to this array
;
; Output
; 1 - Block action (MT Required)
; 0 - Don't block action (MT Not required)
;
N RSLT,EASMT,EASTXT,EASX,EAMTS,DSPLY,IENS
;
S RSLT=0
S EASQT=+$G(EASQT)
S EASAPT=+$G(EASAPT)
S EASDT=$G(EASDT)
S EASACT=$G(EASACT)
S:EASACT']"" EASACT="O"
; If Appt type is not defined, action is CI/CO, get appt date
I 'EASAPT,EASACT="C",EASDT]"" D
.N DGARRAY,SDCNT
.S DGARRAY(4)=DFN,DGARRAY("SORT")="P",DGARRAY("FLDS")=10
.S SDCNT=$$SDAPI^SDAMA301(.DGARRAY)
.S EASAPT=+$P($G(^TMP($J,"SDAMA301",DFN,EASDT)),U,10)
.K DGARRAY,SDCNT,^TMP($J,"SDAMA301")
;
Q:$$INP(DFN) RSLT ; Quit if inpatient
S EAMTS=$$MTCHK(DFN,EASACT) ; Get MT Check flag
Q:'EAMTS RSLT
;
;Build Alert message
D BLDMSG(EASACT,.EASTXT)
I $D(EASMSG) M @EASMSG=EASTXT ; If output array defined,copy message test
;
; Check appointment action and appointment type. Set blocking action
I EASACT="M",EASAPT=9 S (DSPLY,RSLT)=1 ; Make an Appt.
;
I EASACT="C" D ; Check-in an appt.
. I $G(EASAPT)=9 S (DSPLY,RSLT)=1
;
I "W,O"[EASACT D ; Walk-in/Other appt.
. S:$G(EASAPT)=9 DSPLY=1
;
I $G(DSPLY) D
. Q:EASQT ; If silent flag is set, do not display alert
. S EASX=0
. W !?5,$CHAR(7),"******************************************************"
. F S EASX=$O(EASTXT(EASX)) Q:'EASX D
. . W !?5,EASTXT(EASX)
;
; Check for override key on making appointments
I EASACT="M" D
. I $D(^XUSEC("EAS MTOVERRIDE",DUZ)) S RSLT=0
Q $G(RSLT)
;
MTCHK(DFN,EASACT) ; Check Means Test Status
; Input
; DFN
;
; Output
; 0 OK
; 1 MEANS TEST Required
;
N RSLT,EASTAT,EASDT
;
S RSLT=0
S EASTAT=$$LST^DGMTU(DFN,"",1)
I EASTAT]"" D
. I $P(EASTAT,U,4)="R" S RSLT=1 Q
. ;; Condition Check: MT Stat="P" AND GMT Threshold>Threshold A
. ;; AND MT Date is after 10/5/1999 AND Agrees to pay Deductible
. ;; AND MT Date is older than 365 days, THEN MT is required
. ;; EAS*1.0*106 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
. I $P(EASTAT,U,4)="P",$$GET1^DIQ(408.31,+EASTAT,.27,"I")>$$GET1^DIQ(408.31,+EASTAT,.12,"I"),$P(EASTAT,U,2)>2991005,$$GET1^DIQ(408.31,+EASTAT,.11,"I"),$$OLDMTPF^DGMTU4($P(EASTAT,U,2)) S RSLT=1 Q
. ;; Condition Check: Cat C or Pending Adj.
. ;; AND Agrees to pay Deductible AND MT date after 10/5/1999
. I "C,P"[$P(EASTAT,U,4),$$GET1^DIQ(408.31,+EASTAT,.11,"I"),$P(EASTAT,U,2)>2991005 Q
. ;; EAS*1.0*106 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
. I $P(EASTAT,U,4)="P",$$GET1^DIQ(408.31,+EASTAT,.27,"I")>$$GET1^DIQ(408.31,+EASTAT,.12,"I"),$P(EASTAT,U,2)>2991005,$$GET1^DIQ(408.31,+EASTAT,.11,"I"),$$OLDMTPF^DGMTU4($P(EASTAT,U,2)) S RSLT=1 Q
. ;; Condition Check: Cat C AND Declines to give income information AND Agreed to pay deductible
. I $P(EASTAT,U,4)="C",$$GET1^DIQ(408.31,+EASTAT,.14,"I"),$$GET1^DIQ(408.31,+EASTAT,.11,"I") Q
. S EASDT=$P(EASTAT,U,2)
. ;; EAS*1.0*106 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
. I $$OLDMTPF^DGMTU4(EASDT) S RSLT=1
. I $G(EASACT)="L" D
. . ;; For letters, need to check for letters past 60-day threshold
. . I ($$FMDIFF^XLFDT(DT,EASDT)>304) S RSLT=1
;
I $P(EASTAT,U,4)="N" S RSLT=0
Q $G(RSLT)
;
BLDMSG(EASACT,EASTXT) ; Build alert message to user
N LINE
;
S LINE=1
S EASTXT(LINE)="Means Test Alert",LINE=LINE+1
S EASTXT(LINE)="A Means Test is required or needs to be completed.",LINE=LINE+1
;
I "M,C,W"[EASACT D
. S EASTXT(LINE)="Please perform MEANS TEST or instruct patient",LINE=LINE+1
. S EASTXT(LINE)="to report for Means Test interview.",LINE=LINE+1
;
I EASACT="M" D
. S EASTXT(LINE)=">> A future appointment cannot be made at this time."
. S:$D(^XUSEC("EAS MTOVERRIDE",DUZ)) EASTXT(LINE)=">> Override Key in Effect."
. S LINE=LINE+1
;
I EASACT="C" S EASTXT(LINE)=">> This action may not be completed at this time.",LINE=LINE+1
I EASACT="W" D
. S EASTXT(LINE)=">> Check-Out ONLY. Do NOT Check-In (CI) a walk-in appointment",LINE=LINE+1
. S EASTXT(LINE)=" You will not be able to check-out the appt. if you do so.",LINE=LINE+1
Q
;
INP(DFN) ; Check on Inpatient status
; Input
; DFN - IEN from patient file
; Output
; 1 - Patient has Inpatient status
; 0 - Patient does not have Inpatient status
; Default
; Inpatient API defaults to TODAY for inpatient status check
;
N VAERR,EAIN,VAROOT,VAINDT
;
S VAINDT=$$NOW^XLFDT,VAROOT="EAIN"
;; Modified to treat DOM patients as inpatients for the purpose of appointment blocking.
;; EAS*1*12
D INP^VADPT
Q $S(+$G(EAIN(1)):1,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASMTCHK 6777 printed Sep 23, 2025@19:31:27 Page 2
EASMTCHK ;ALB/SCK,PJR,BDB - MEANS TEST BLOCKING CHECK ; 11/13/03 11:13am
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,12,15,38,46,106**;MAR 15,2001;Build 28
+2 ; This routine provides an API, which when called from Appointment Management will allow
+3 ; for the blocking of future appointments and appointment check-in/out if the patient
+4 ; requires a Means Test or has a Means Test Status of Required. $$LST^DGMTU is used
+5 ; to determine if a MT is REQUIRED. If a MT does not have a status of REQUIRED,
+6 ; but is more than 365 days out (same criteria used in OLD^DGMTU4), the MT will
+7 ; be considered "REQUIRED" for blocking purposes. If a Means Test is required, the
+8 ; following combinations of appointment actions will be blocked:
+9 ; o Making a future appt for a Regular appt type
+10 ; o Check In/Out an appt which is either a Regular or Research type
+11 ;
+12 ; A Walk-in will see the alert notice, and will be warned NOT to CHECK-IN the walk-in
+13 ; appointment. Unscheduled/Walk-ins can ONLY be checked out.
+14 ;
+15 ; This API may be passed a flag to "silence" the screen display of the alert message, and
+16 ; will accept an array variable to return the alert text in. Inpatient appointments
+17 ; are not affected in any way. Domicilary are not considered inpatients for the purpose
+18 ; of Means Test Blocking for appointments
+19 ;
MT(DFN,EASAPT,EASACT,EASDT,EASQT,EASMSG) ; Entry point for MT Check
+1 ; Input Variables
+2 ; DFN - Patient's IEN in File #2
+3 ; EASAPT - Appointment Type (File #409.1) [Optional]
+4 ; EASACT - Appointment Action Flag [Optional] Default = "Other"
+5 ; "M" - Make an Appointment
+6 ; "C" - Check In/Out an existing appointment
+7 ; "W" - Unscheduled/Walk-in appointment
+8 ; "O" - Other
+9 ; "L" - Letters
+10 ;
+11 ; EASDT - Appointment Date/Time [Optional]
+12 ; EASQT - Silent flag [Optional], if set will prevent display of alert message
+13 ; EASMSG - Return array for alert message [Optional], if passed in, the alert
+14 ; message text will be copied to this array
+15 ;
+16 ; Output
+17 ; 1 - Block action (MT Required)
+18 ; 0 - Don't block action (MT Not required)
+19 ;
+20 NEW RSLT,EASMT,EASTXT,EASX,EAMTS,DSPLY,IENS
+21 ;
+22 SET RSLT=0
+23 SET EASQT=+$GET(EASQT)
+24 SET EASAPT=+$GET(EASAPT)
+25 SET EASDT=$GET(EASDT)
+26 SET EASACT=$GET(EASACT)
+27 if EASACT']""
SET EASACT="O"
+28 ; If Appt type is not defined, action is CI/CO, get appt date
+29 IF 'EASAPT
IF EASACT="C"
IF EASDT]""
Begin DoDot:1
+30 NEW DGARRAY,SDCNT
+31 SET DGARRAY(4)=DFN
SET DGARRAY("SORT")="P"
SET DGARRAY("FLDS")=10
+32 SET SDCNT=$$SDAPI^SDAMA301(.DGARRAY)
+33 SET EASAPT=+$PIECE($GET(^TMP($JOB,"SDAMA301",DFN,EASDT)),U,10)
+34 KILL DGARRAY,SDCNT,^TMP($JOB,"SDAMA301")
End DoDot:1
+35 ;
+36 ; Quit if inpatient
if $$INP(DFN)
QUIT RSLT
+37 ; Get MT Check flag
SET EAMTS=$$MTCHK(DFN,EASACT)
+38 if 'EAMTS
QUIT RSLT
+39 ;
+40 ;Build Alert message
+41 DO BLDMSG(EASACT,.EASTXT)
+42 ; If output array defined,copy message test
IF $DATA(EASMSG)
MERGE @EASMSG=EASTXT
+43 ;
+44 ; Check appointment action and appointment type. Set blocking action
+45 ; Make an Appt.
IF EASACT="M"
IF EASAPT=9
SET (DSPLY,RSLT)=1
+46 ;
+47 ; Check-in an appt.
IF EASACT="C"
Begin DoDot:1
+48 IF $GET(EASAPT)=9
SET (DSPLY,RSLT)=1
End DoDot:1
+49 ;
+50 ; Walk-in/Other appt.
IF "W,O"[EASACT
Begin DoDot:1
+51 if $GET(EASAPT)=9
SET DSPLY=1
End DoDot:1
+52 ;
+53 IF $GET(DSPLY)
Begin DoDot:1
+54 ; If silent flag is set, do not display alert
if EASQT
QUIT
+55 SET EASX=0
+56 WRITE !?5,$CHAR(7),"******************************************************"
+57 FOR
SET EASX=$ORDER(EASTXT(EASX))
if 'EASX
QUIT
Begin DoDot:2
+58 WRITE !?5,EASTXT(EASX)
End DoDot:2
End DoDot:1
+59 ;
+60 ; Check for override key on making appointments
+61 IF EASACT="M"
Begin DoDot:1
+62 IF $DATA(^XUSEC("EAS MTOVERRIDE",DUZ))
SET RSLT=0
End DoDot:1
+63 QUIT $GET(RSLT)
+64 ;
MTCHK(DFN,EASACT) ; Check Means Test Status
+1 ; Input
+2 ; DFN
+3 ;
+4 ; Output
+5 ; 0 OK
+6 ; 1 MEANS TEST Required
+7 ;
+8 NEW RSLT,EASTAT,EASDT
+9 ;
+10 SET RSLT=0
+11 SET EASTAT=$$LST^DGMTU(DFN,"",1)
+12 IF EASTAT]""
Begin DoDot:1
+13 IF $PIECE(EASTAT,U,4)="R"
SET RSLT=1
QUIT
+14 ;; Condition Check: MT Stat="P" AND GMT Threshold>Threshold A
+15 ;; AND MT Date is after 10/5/1999 AND Agrees to pay Deductible
+16 ;; AND MT Date is older than 365 days, THEN MT is required
+17 ;; EAS*1.0*106 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
+18 IF $PIECE(EASTAT,U,4)="P"
IF $$GET1^DIQ(408.31,+EASTAT,.27,"I")>$$GET1^DIQ(408.31,+EASTAT,.12,"I")
IF $PIECE(EASTAT,U,2)>2991005
IF $$GET1^DIQ(408.31,+EASTAT,.11,"I")
IF $$OLDMTPF^DGMTU4($PIECE(EASTAT,U,2))
SET RSLT=1
QUIT
+19 ;; Condition Check: Cat C or Pending Adj.
+20 ;; AND Agrees to pay Deductible AND MT date after 10/5/1999
+21 IF "C,P"[$PIECE(EASTAT,U,4)
IF $$GET1^DIQ(408.31,+EASTAT,.11,"I")
IF $PIECE(EASTAT,U,2)>2991005
QUIT
+22 ;; EAS*1.0*106 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
+23 IF $PIECE(EASTAT,U,4)="P"
IF $$GET1^DIQ(408.31,+EASTAT,.27,"I")>$$GET1^DIQ(408.31,+EASTAT,.12,"I")
IF $PIECE(EASTAT,U,2)>2991005
IF $$GET1^DIQ(408.31,+EASTAT,.11,"I")
IF $$OLDMTPF^DGMTU4($PIECE(EASTAT,U,2))
SET RSLT=1
QUIT
+24 ;; Condition Check: Cat C AND Declines to give income information AND Agreed to pay deductible
+25 IF $PIECE(EASTAT,U,4)="C"
IF $$GET1^DIQ(408.31,+EASTAT,.14,"I")
IF $$GET1^DIQ(408.31,+EASTAT,.11,"I")
QUIT
+26 SET EASDT=$PIECE(EASTAT,U,2)
+27 ;; EAS*1.0*106 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
+28 IF $$OLDMTPF^DGMTU4(EASDT)
SET RSLT=1
+29 IF $GET(EASACT)="L"
Begin DoDot:2
+30 ;; For letters, need to check for letters past 60-day threshold
+31 IF ($$FMDIFF^XLFDT(DT,EASDT)>304)
SET RSLT=1
End DoDot:2
End DoDot:1
+32 ;
+33 IF $PIECE(EASTAT,U,4)="N"
SET RSLT=0
+34 QUIT $GET(RSLT)
+35 ;
BLDMSG(EASACT,EASTXT) ; Build alert message to user
+1 NEW LINE
+2 ;
+3 SET LINE=1
+4 SET EASTXT(LINE)="Means Test Alert"
SET LINE=LINE+1
+5 SET EASTXT(LINE)="A Means Test is required or needs to be completed."
SET LINE=LINE+1
+6 ;
+7 IF "M,C,W"[EASACT
Begin DoDot:1
+8 SET EASTXT(LINE)="Please perform MEANS TEST or instruct patient"
SET LINE=LINE+1
+9 SET EASTXT(LINE)="to report for Means Test interview."
SET LINE=LINE+1
End DoDot:1
+10 ;
+11 IF EASACT="M"
Begin DoDot:1
+12 SET EASTXT(LINE)=">> A future appointment cannot be made at this time."
+13 if $DATA(^XUSEC("EAS MTOVERRIDE",DUZ))
SET EASTXT(LINE)=">> Override Key in Effect."
+14 SET LINE=LINE+1
End DoDot:1
+15 ;
+16 IF EASACT="C"
SET EASTXT(LINE)=">> This action may not be completed at this time."
SET LINE=LINE+1
+17 IF EASACT="W"
Begin DoDot:1
+18 SET EASTXT(LINE)=">> Check-Out ONLY. Do NOT Check-In (CI) a walk-in appointment"
SET LINE=LINE+1
+19 SET EASTXT(LINE)=" You will not be able to check-out the appt. if you do so."
SET LINE=LINE+1
End DoDot:1
+20 QUIT
+21 ;
INP(DFN) ; Check on Inpatient status
+1 ; Input
+2 ; DFN - IEN from patient file
+3 ; Output
+4 ; 1 - Patient has Inpatient status
+5 ; 0 - Patient does not have Inpatient status
+6 ; Default
+7 ; Inpatient API defaults to TODAY for inpatient status check
+8 ;
+9 NEW VAERR,EAIN,VAROOT,VAINDT
+10 ;
+11 SET VAINDT=$$NOW^XLFDT
SET VAROOT="EAIN"
+12 ;; Modified to treat DOM patients as inpatients for the purpose of appointment blocking.
+13 ;; EAS*1*12
+14 DO INP^VADPT
+15 QUIT $SELECT(+$GET(EAIN(1)):1,1:0)
