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

DGENA2.m

Go to the documentation of this file. 
  1. DGENA2 ;ALB/CJM,RTK,TDM - Enrollment API - Automatic Update; 9/19/2002 ; 1/31/03 11:54am
  1.  ;;5.3;PIMS;**121,122,147,232,327,469,491,1015,1016**;JUN 30, 2012;Build 20
  1.  ;
  1. AUTOUPD(DFN,EVENT) ;
  1.  ;Description: If the patient meets the criteria for transmission to HEC,
  1.  ;   he is entered to the IVM PATIENT file for future transmission.
  1.  ;   This procedure checks for changes in enrollment priority,
  1.  ;   status and fields in the eligibility sub-record. If any changes are
  1.  ;   found, the current enrollment record is automatically updated.
  1.  ;Input:
  1.  ;  DFN - Patient IEN
  1.  ;  EVENT - Event Type (optional)
  1.  ;          EVENT 1 : Date of Death Deleted
  1.  ;          EVENT 2 : Ineligible Date Deleted
  1.  ;Output: None
  1.  ;
  1.  ;if the eligibility/enrollment upload is in progess, do not do anything
  1.  Q:($G(DGENUPLD)="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS")
  1.  ;
  1.  ; If the INCOME TEST DATA (Z10) upload is in progess, do not do anything
  1.  Q:($G(IVMZ10)="UPLOAD IN PROGRESS")
  1.  ;
  1.  N DGENRIEN,DGENR1,DGENR2,STATUS,EFFDATE,OK,DEATH
  1.  ;
  1.  ;try to prevent problems rsulting from calling FM within FM
  1.  N DS,D0,DO,D1,DA,DD,DS,DG,DIC,DICR,DIE,DIG,DIH,DIV,DIW,DIX,DQ,DR
  1.  ;
  1.  S EVENT=+$G(EVENT)
  1.  ;
  1.  D EVENT^IVMPLOG(DFN)
  1.  ;
  1.  D:$$LOCK^DGENA1($G(DFN))  ;may drop out of block
  1.  .S DGENRIEN=$$FINDCUR^DGENA(DFN)
  1.  .Q:'DGENRIEN
  1.  .Q:'$$GET^DGENA(DGENRIEN,.DGENR1)
  1.  .S STATUS=$$EXT^DGENU("STATUS",DGENR1("STATUS"))
  1.  .S (DEATH,EFFDATE)=$$DEATH^DGENPTA(DFN)
  1.  .I STATUS'="VERIFIED",STATUS'="UNVERIFIED",STATUS'="DECEASED",STATUS'["NOT ELIGIBLE",STATUS'["PENDING",STATUS'["REJECTED" Q
  1.  .I STATUS="DECEASED",((EVENT'=1)!(DEATH)) Q
  1.  .I STATUS["NOT ELIGIBLE",((EVENT'=2)!('$$VET^DGENPTA(DFN))) Q
  1.  .S:'EFFDATE EFFDATE=DT
  1.  .Q:'$$CREATE^DGENA6(DFN,DGENR1("APP"),EFFDATE,DGENR1("REASON"),DGENR1("REMARKS"),.DGENR2,DGENR1("DATE"),DGENR1("END"))
  1.  .S OK=1
  1.  .S:(DGENR1("PRIORITY")'=DGENR2("PRIORITY"))!(DGENR2("STATUS")'=DGENR1("STATUS")) OK=0
  1.  .I OK D
  1.  ..N SUB
  1.  ..S SUB=""
  1.  ..F  S SUB=$O(DGENR2("ELIG",SUB)) Q:SUB=""  S:(DGENR1("ELIG",SUB)'=DGENR2("ELIG",SUB)) OK=0
  1.  .I 'OK D
  1.  ..I (DGENR1("EFFDATE")=DGENR2("EFFDATE")),(DGENR1("SOURCE")=DGENR2("SOURCE")),(DGENR1("USER")=DGENR2("USER")),(DGENR1("DATETIME")\1)=(DGENR2("DATETIME")\1) D
  1.  ...;in this case it's an overlay
  1.  ...S DGENR2("PRIORREC")=DGENR1("PRIORREC")
  1.  ...I $$EDITCUR^DGENA1(.DGENR2)
  1.  ..E  D
  1.  ...;in this case create a new record, to preserve the audit trail
  1.  ...I $$STORECUR^DGENA1(.DGENR2)
  1.  D UNLOCK^DGENA1($G(DFN))
  1.  Q
  1. MTUPD ;
  1.  ;Description - entry point for Means Test Event Driver for Enrollment
  1.  ;
  1.  D AUTOUPD($G(DFN))
  1.  Q
  1.  ;
  1. SDDIS ;Entry point for the DGEN SD DISPLAY CURRENT ENROLLMENT protocol,
  1.  ;which hangs of the Scheduling Event Driver
  1.  ;
  1.  N DFN S DFN=$P($G(SDATA),"^",2)
  1.  ;
  1.  ;don't display if running in the background
  1.  Q:$D(ZTQUEUED)
  1.  ;
  1.  ;don't want to display enrollment for non-vets with no enrollment status
  1.  Q:('$$VET^DGENPTA(DFN))&('$$STATUS^DGENA(DFN))
  1.  ;
  1.  ;if making an appt., & in interactive mode, display enrollment status
  1.  I ($G(SDAMEVT)=1),$G(SDMODE)=0 D
  1.  .D DISPLAY^DGENU($P($G(SDATA),"^",2))
  1.  .D PAUSE^VALM1
  1.  ;
  1.  ;want to do the same thing for check-in, unless appt just made
  1.  I ($G(SDAMEVT)=4),$G(SDMODE)=0 D
  1.  .;want to try avoiding giving display if it was done already
  1.  .;so, if it is an unscheduled appt made today, skip
  1.  .N PTNODE,SCNODE
  1.  .S SCNODE=$G(^TMP("SDAMEVT",$J,"AFTER","SC"))
  1.  .S PTNODE=$G(^TMP("SDAMEVT",$J,"AFTER","DPT"))
  1.  .I +$P(SCNODE,"^",7)=$G(DT),$P(PTNODE,"^",7)=4 Q  ;unscheduled appt made today
  1.  .D DISPLAY^DGENU($P($G(SDATA),"^",2))
  1.  .D PAUSE^VALM1
  1.  Q
  1.  ;
  1. ENROLL ;Entry point for the DGEN SD ENROLL PATIENT protocol, which hangs of
  1.  ;the Scheduling Event Driver. This event enrolls patients upon check-out
  1.  ;if there is no prior enrollment record.
  1.  ;
  1.  ; Input  -- SDATA & SDAMEVT defined by the scheduling event driver
  1.  ; Output -- none
  1.  ;
  1.  N DGENR,DFN
  1.  ;
  1.  ;NOTE - it appears from testing that means test status REQUIRED is set
  1.  ;within scheduling, obviating the need to do it here.  This is why
  1.  ;several lines are commented out.
  1.  ;
  1.  ;N DGENR,DGOKF,DGREQF,DFN,DGMSGF,DG,DGMT,DGMTCOR,DGMTE,DGRGAUTO,DGWRT,XMZ,DIG,DIH
  1.  ;
  1.  ;appointment made, check if enrollment appointment request needs reset.
  1.  ;if appointment cancelled, or no-show put back on call list if no appts.
  1.  I ($G(SDAMEVT)=1)!($G(SDAMEVT)=2)!($G(SDAMEVT)=3) D REQUST(SDAMEVT,SDATA)
  1.  ;check-out?
  1.  Q:($G(SDAMEVT)'=5)
  1.  ;
  1.  S DFN=$P($G(SDATA),"^",2)
  1.  ;
  1.  ;don't enroll if the patient has an enrollment record
  1.  I $$FINDCUR^DGENA(DFN) Q
  1.  ;
  1.  ;non-vet?
  1.  Q:'$$VET^DGENPTA(DFN)
  1.  ;
  1.  ;dead?
  1.  Q:$$DEATH^DGENPTA(DFN)
  1.  ;
  1.  ;Does patient require a Means Test?
  1.  ;S DGMSGF=1
  1.  ;D EN^DGMTR
  1.  ;
  1.  ;Create local enrollment array
  1.  I $$CREATE^DGENA6(DFN,DT,,,,.DGENR) D
  1.  . ;
  1.  . ;Store local enrollment as current
  1.  . I $$STORECUR^DGENA1(.DGENR) D
  1.  . . ;
  1.  . . ;If patient's means test status is required, send bulletin
  1.  . . ;I $$MTREQ^DGEN(DFN) D MTBULL^DGEN(DFN,.DGENR)
  1.  Q
  1.  ;
  1. REQUST(SDAMEVT,SDATA) ;
  1.  ;1. Check if cancelled appt. If no appts found put back on call list.
  1.  ;2. Automatic collection of Appointment Request Date and Appointment
  1.  ;Request Response
  1.  ;- Set when Enrollment Application Date >= 8/1/2005 AND
  1.  ;-     Appointment Request Date is null. 
  1.  ;
  1.  ; Input  -- SDATA and SDAMEVT defined by scheduling event driver
  1.  ; Output -- none
  1.  ;
  1.  N DGENRIEN,DGENR,DPTERR,DGCOM,DGADT,DFN,DGCLN
  1.  I ($G(SDAMEVT)=2)!($G(SDAMEVT)=3) G CANNS
  1.  ;apointment made?
  1.  Q:($G(SDAMEVT)'=1)
  1.  ;
  1.  S DFN=$P($G(SDATA),"^",2)
  1.  S DGADT=$P($G(SDATA),"^",3)
  1.  S DGCLN=$P($G(SDATA),"^",4)
  1.  ;get enrollment ien
  1.  S DGENRIEN=$$FINDCUR^DGENA(DFN)
  1.  I DGENRIEN,$$GET^DGENA(DGENRIEN,.DGENR) ;set-up enrollment array
  1.  I $G(DGENR("APP"))>3050731 D
  1.  . ;and, no appointment request date. Set request="yes", request date 
  1.  . I '$$GET1^DIQ(2,DFN,1010.1511,"I") D
  1.  . . ;quit if 'no-count' clinic
  1.  . . I ($$GET1^DIQ(44,DGCLN,2502,"I")="Y") Q
  1.  . . ;quit if appt. date/time < date notified of request for appointment
  1.  . . I DGADT<DT Q
  1.  . . ;set fields
  1.  . . N FDATA
  1.  . . S FDATA(2,DFN_",",1010.159)=1
  1.  . . S FDATA(2,DFN_",",1010.1511)=DT
  1.  . . D FILE^DIE("","FDATA","DPTERR")
  1.  . ;if appointment made, appt. request="yes", request status'="filled"
  1.  . ;- set request status='filled' w comment
  1.  . ; also, if non count clinic, do not file data.
  1.  . I ($$GET1^DIQ(44,DGCLN,2502,"I")="Y") Q
  1.  . I ($$GET1^DIQ(2,DFN,1010.159,"I")),($$GET1^DIQ(2,DFN,1010.161,"I")'="F") D
  1.  . . ;set fields
  1.  . . N FDATA
  1.  . . S FDATA(2,DFN_",",1010.161)="F"
  1.  . . S DGCOM=$$GET1^DIQ(2,DFN,1010.163)
  1.  . . S DGCOM=DGCOM_$S(DGCOM'="":"<>",1:"")_"AutoComm:"_$S($$GET1^DIQ(2,DFN,1010.161,"I")="":"null",1:$S($$GET1^DIQ(2,DFN,1010.161,"I")="I":"IN PROGRESS",1:$$GET1^DIQ(2,DFN,1010.161)))_"|FILLED by Scheduling"
  1.  . . S FDATA(2,DFN_",",1010.163)=DGCOM
  1.  . . D FILE^DIE("","FDATA","DPTERR")
  1.  Q
  1.  ;
  1. CANNS ;If appointment cancelled or no-show, no appts made, put back on call list
  1.  N DGRDTI,SDARRY,SDCNT,FDATA
  1.  ;
  1.  S DFN=$P($G(SDATA),"^",2)
  1.  ;
  1.  S DGRDTI=$$GET1^DIQ(2,DFN,1010.1511,"I")
  1.  I 'DGRDTI Q
  1.  S SDARRY(1)=DGRDTI_";" ;Look out from 'notify of request date' to future.
  1.  S SDARRY(3)="R;I;NT" ;appointments made
  1.  S SDARRY(4)=DFN
  1.  S SDARRY("FLDS")=1
  1.  S SDCNT=$$SDAPI^SDAMA301(.SDARRY)
  1.  I SDCNT>0 D  ;If only no-count clinic appts. put on call list
  1.  . N SDCOUNT,SDCL
  1.  . S SDCOUNT=0 ; count clinic
  1.  . S SDCL=0 F  S SDCL=$O(^TMP($J,"SDAMA301",DFN,SDCL)) Q:'SDCL  D  Q:SDCOUNT
  1.  .. I $$GET1^DIQ(44,SDCL,2502,"I")="Y" Q
  1.  .. S SDCOUNT=SDCOUNT+1
  1.  . I SDCOUNT=0 S SDCNT=0  ;if only no-count clinic appts., put on call list
  1.  I SDCNT=0 D
  1.  . S FDATA(2,DFN_",",1010.161)="@" ;delete status
  1.  . S FDATA(2,DFN_",",1010.163)="@" ;delete comment
  1.  . D FILE^DIE("","FDATA","DPTERR")
  1.  Q