Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: EASMTCHK

EASMTCHK.m

Go to the documentation of this file. 
  1. 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
  1.  ; This routine provides an API, which when called from Appointment Management will allow 
  1.  ; for the blocking of future appointments and appointment check-in/out if the patient 
  1.  ; requires a Means Test or has a Means Test Status of Required. $$LST^DGMTU is used 
  1.  ; to determine if a MT is REQUIRED.  If a MT does not have a status of REQUIRED, 
  1.  ; but is more than 365 days out (same criteria used in OLD^DGMTU4), the MT will 
  1.  ; be considered "REQUIRED" for blocking purposes. If a Means Test is required, the 
  1.  ; following combinations of appointment actions will be blocked:
  1.  ;    o Making a future appt for a Regular appt type
  1.  ;    o Check In/Out an appt which is either a Regular or Research type
  1.  ;
  1.  ; A Walk-in will see the alert notice, and will be warned NOT to CHECK-IN the walk-in 
  1.  ; appointment. Unscheduled/Walk-ins can ONLY be checked out.
  1.  ;
  1.  ; This API may be passed a flag to "silence" the screen display of the alert message, and 
  1.  ; will accept an array variable to return the alert text in. Inpatient appointments 
  1.  ; are not affected in any way.  Domicilary are not considered inpatients for the purpose 
  1.  ; of Means Test Blocking for appointments
  1.  ;
  1. MT(DFN,EASAPT,EASACT,EASDT,EASQT,EASMSG) ; Entry point for MT Check
  1.  ; Input Variables
  1.  ;    DFN    - Patient's IEN in File #2
  1.  ;    EASAPT - Appointment Type (File #409.1) [Optional]
  1.  ;    EASACT - Appointment Action Flag [Optional] Default = "Other"
  1.  ;             "M"  - Make an Appointment
  1.  ;             "C"  - Check In/Out an existing appointment
  1.  ;             "W"  - Unscheduled/Walk-in appointment
  1.  ;             "O"  - Other
  1.  ;             "L"  - Letters
  1.  ;
  1.  ;    EASDT  - Appointment Date/Time [Optional]
  1.  ;    EASQT  - Silent flag [Optional], if set will prevent display of alert message
  1.  ;    EASMSG - Return array for alert message [Optional], if passed in, the alert 
  1.  ;             message text will be copied to this array
  1.  ;
  1.  ; Output
  1.  ;    1  - Block action (MT Required)
  1.  ;    0  - Don't block action (MT Not required)
  1.  ;
  1.  N RSLT,EASMT,EASTXT,EASX,EAMTS,DSPLY,IENS
  1.  ;
  1.  S RSLT=0
  1.  S EASQT=+$G(EASQT)
  1.  S EASAPT=+$G(EASAPT)
  1.  S EASDT=$G(EASDT)
  1.  S EASACT=$G(EASACT)
  1.  S:EASACT']"" EASACT="O"
  1.  ; If Appt type is not defined, action is CI/CO, get appt date
  1.  I 'EASAPT,EASACT="C",EASDT]"" D
  1.  .N DGARRAY,SDCNT
  1.  .S DGARRAY(4)=DFN,DGARRAY("SORT")="P",DGARRAY("FLDS")=10
  1.  .S SDCNT=$$SDAPI^SDAMA301(.DGARRAY)
  1.  .S EASAPT=+$P($G(^TMP($J,"SDAMA301",DFN,EASDT)),U,10)
  1.  .K DGARRAY,SDCNT,^TMP($J,"SDAMA301")
  1.  ;
  1.  Q:$$INP(DFN) RSLT       ; Quit if inpatient
  1.  S EAMTS=$$MTCHK(DFN,EASACT)    ; Get MT Check flag
  1.  Q:'EAMTS RSLT
  1.  ;
  1.  ;Build Alert message 
  1.  D BLDMSG(EASACT,.EASTXT)
  1.  I $D(EASMSG) M @EASMSG=EASTXT ; If output array defined,copy message test
  1.  ;
  1.  ; Check appointment action and appointment type.  Set blocking action
  1.  I EASACT="M",EASAPT=9 S (DSPLY,RSLT)=1 ; Make an Appt.
  1.  ;
  1.  I EASACT="C" D  ; Check-in an appt.
  1.  . I $G(EASAPT)=9 S (DSPLY,RSLT)=1
  1.  ;
  1.  I "W,O"[EASACT D  ; Walk-in/Other appt.
  1.  . S:$G(EASAPT)=9 DSPLY=1
  1.  ;
  1.  I $G(DSPLY) D
  1.  . Q:EASQT  ; If silent flag is set, do not display alert
  1.  . S EASX=0
  1.  . W !?5,$CHAR(7),"******************************************************"
  1.  . F  S EASX=$O(EASTXT(EASX)) Q:'EASX  D
  1.  . . W !?5,EASTXT(EASX)
  1.  ;
  1.  ; Check for override key on making appointments
  1.  I EASACT="M" D
  1.  . I $D(^XUSEC("EAS MTOVERRIDE",DUZ)) S RSLT=0
  1.  Q $G(RSLT)
  1.  ;
  1. MTCHK(DFN,EASACT) ; Check Means Test Status
  1.  ; Input
  1.  ;     DFN
  1.  ;
  1.  ; Output  
  1.  ;     0   OK
  1.  ;     1   MEANS TEST Required
  1.  ;
  1.  N RSLT,EASTAT,EASDT
  1.  ;
  1.  S RSLT=0
  1.  S EASTAT=$$LST^DGMTU(DFN,"",1)
  1.  I EASTAT]"" D
  1.  . I $P(EASTAT,U,4)="R" S RSLT=1 Q
  1.  . ;; Condition Check: MT Stat="P" AND GMT Threshold>Threshold A
  1.  . ;;  AND MT Date is after 10/5/1999 AND Agrees to pay Deductible
  1.  . ;;  AND MT Date is older than 365 days, THEN MT is required
  1.  . ;; EAS*1.0*106  MT less than 1 year old as of "VFA Start Date" and point forward do not expire
  1.  . 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
  1.  . ;; Condition Check: Cat C or Pending Adj.
  1.  . ;;  AND Agrees to pay Deductible AND MT date after 10/5/1999
  1.  . I "C,P"[$P(EASTAT,U,4),$$GET1^DIQ(408.31,+EASTAT,.11,"I"),$P(EASTAT,U,2)>2991005 Q
  1.  . ;; EAS*1.0*106  MT less than 1 year old as of "VFA Start Date" and point forward do not expire
  1.  . 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
  1.  . ;; Condition Check: Cat C AND Declines to give income information AND Agreed to pay deductible
  1.  . I $P(EASTAT,U,4)="C",$$GET1^DIQ(408.31,+EASTAT,.14,"I"),$$GET1^DIQ(408.31,+EASTAT,.11,"I") Q
  1.  . S EASDT=$P(EASTAT,U,2)
  1.  . ;; EAS*1.0*106  MT less than 1 year old as of "VFA Start Date" and point forward do not expire
  1.  . I $$OLDMTPF^DGMTU4(EASDT) S RSLT=1
  1.  . I $G(EASACT)="L" D
  1.  . . ;; For letters, need to check for letters past 60-day threshold
  1.  . . I ($$FMDIFF^XLFDT(DT,EASDT)>304) S RSLT=1
  1.  ;
  1.  I $P(EASTAT,U,4)="N" S RSLT=0
  1.  Q $G(RSLT)
  1.  ;
  1. BLDMSG(EASACT,EASTXT) ; Build alert message to user
  1.  N LINE
  1.  ;
  1.  S LINE=1
  1.  S EASTXT(LINE)="Means Test Alert",LINE=LINE+1
  1.  S EASTXT(LINE)="A Means Test is required or needs to be completed.",LINE=LINE+1
  1.  ;
  1.  I "M,C,W"[EASACT D
  1.  . S EASTXT(LINE)="Please perform MEANS TEST or instruct patient",LINE=LINE+1
  1.  . S EASTXT(LINE)="to report for Means Test interview.",LINE=LINE+1
  1.  ;
  1.  I EASACT="M" D
  1.  . S EASTXT(LINE)=">> A future appointment cannot be made at this time."
  1.  . S:$D(^XUSEC("EAS MTOVERRIDE",DUZ)) EASTXT(LINE)=">> Override Key in Effect."
  1.  . S LINE=LINE+1
  1.  ;
  1.  I EASACT="C" S EASTXT(LINE)=">> This action may not be completed at this time.",LINE=LINE+1
  1.  I EASACT="W" D
  1.  . S EASTXT(LINE)=">> Check-Out ONLY.  Do NOT Check-In (CI) a walk-in appointment",LINE=LINE+1
  1.  . S EASTXT(LINE)="   You will not be able to check-out the appt. if you do so.",LINE=LINE+1
  1.  Q
  1.  ;
  1. INP(DFN) ; Check on Inpatient status
  1.  ;  Input
  1.  ;     DFN   - IEN from patient file
  1.  ;  Output
  1.  ;     1 - Patient has Inpatient status 
  1.  ;     0 - Patient does not have Inpatient status
  1.  ;  Default
  1.  ;     Inpatient API defaults to TODAY for inpatient status check
  1.  ;
  1.  N VAERR,EAIN,VAROOT,VAINDT
  1.  ;
  1.  S VAINDT=$$NOW^XLFDT,VAROOT="EAIN"
  1.  ;; Modified to treat DOM patients as inpatients for the purpose of appointment blocking.
  1.  ;; EAS*1*12
  1.  D INP^VADPT
  1.  Q $S(+$G(EAIN(1)):1,1:0)