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,JAM,ASF,RN,JAM - Enrollment API - Automatic Update; 9/19/2002 ;1/31/03 11:54am
  1. ;;5.3;Registration;**121,122,147,232,327,469,491,779,788,824,982,993,1015,1045,1111**;Aug 13,1993;Build 18
  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. .; DG*5.3*1045; comment out the line below. Do not use the global variable DGENRYN.
  1. .; Instead, the PT APPLIED FOR ENROLLMENT? field is retrieved in the $$GET^DGENA
  1. .;S:$G(DGENRYN)="" DGENRYN=$$GET1^DIQ(27.11,DGENRIEN_",",.14,"I") ;DG*5.3*993 Load new PT APPLIED FOR ENROLLMENT? field
  1. .Q:'$$GET^DGENA(DGENRIEN,.DGENR1)
  1. .S STATUS=$$EXT^DGENU("STATUS",DGENR1("STATUS"))
  1. .S (DEATH,EFFDATE)=$$DEATH^DGENPTA(DFN)
  1. .; DG*5.3*1111 - ENROLLMENT STATUS (file #27.15) entries of REJECTED renamed to DEFERRED. The check below modified to look for DEFERRED instead of REJECTED
  1. .I STATUS'="VERIFIED",STATUS'="UNVERIFIED",STATUS'="DECEASED",STATUS'="REGISTRATION ONLY",STATUS'["NOT ELIGIBLE",STATUS'["PENDING",STATUS'["DEFERRED" Q ;DG*5.3*993 Added REGISTRATION ONLY
  1. .I STATUS="DECEASED",((EVENT'=1)!(DEATH)) Q
  1. .I DEATH,'$$VET^DGENPTA(DFN) Q ;DG*5.3*993
  1. .; DG*5.3*1045 Commented the below line to update the Not Eligible, Inelgible Date status in the Patient Enrollment file.
  1. .;I STATUS["NOT ELIGIBLE",((EVENT'=2)!('$$VET^DGENPTA(DFN))) Q
  1. .S:'EFFDATE EFFDATE=DT
  1. .; DG*5.3*1045; comment out line below and replace the 9th parameter DGENRYN with DGENR1 array value
  1. .;Q:'$$CREATE^DGENA6(DFN,DGENR1("APP"),EFFDATE,DGENR1("REASON"),DGENR1("REMARKS"),.DGENR2,DGENR1("DATE"),DGENR1("END"),DGENRYN) ;DG*5.3*993 Added 9th parameter DGENRYN
  1. .Q:'$$CREATE^DGENA6(DFN,DGENR1("APP"),EFFDATE,DGENR1("REASON"),DGENR1("REMARKS"),.DGENR2,DGENR1("DATE"),DGENR1("END"),DGENR1("PTAPPLIED"))
  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. ; $$GET1^DIQ to file #44 supported by ICR #93-A
  1. ; and file #40.07 supported by ICR #93-C (only FM read to access field 1 - not using the "C" cross reference)
  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 'non-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. . . ; jam; DG*5.3*982 - If not a Primary Care appointment, do not file data
  1. . . ; -get clinic stop codes and call logic to check for and quit if this is a Primary Care Appt.
  1. . . N DGSCODE,DGCRCODE
  1. . . S DGSCODE=$$GET1^DIQ(44,DGCLN,8,"I"),DGCRCODE=$$GET1^DIQ(44,DGCLN,2503,"I")
  1. . . S DGSCODE=$$GET1^DIQ(40.7,DGSCODE,1),DGCRCODE=$$GET1^DIQ(40.7,DGCRCODE,1)
  1. . . ; ASF DG*5.3*1015 - remove primary clinic requirement
  1. . . ;I '$$PCACHK^DGENACL2(DGSCODE,DGCRCODE) Q
  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. ; jam; DG*5.3*982 - Modify this logic to add check for Primary Care Appointments. If no PCA, put on the call list
  1. ; jam; DG*5.3*982; get fields 13, 14 and 15 (Primary Stop Code and IEN and Credit Stop Code and IEN and Non-Count Clinic indicator)
  1. S SDARRY("FLDS")="13;14;15"
  1. S SDCNT=$$SDAPI^SDAMA301(.SDARRY)
  1. I SDCNT>0 D ;If only non-count clinic appts. put on call list, (DG*5.3*982 - or if no Primary Care appts, put on call list)
  1. . N DGCOUNT,DGSDCL,DGSDADT,DGAPPT,DGCREDIT,DGSTOP
  1. . S DGCOUNT=0 ; count clinic
  1. . S DGSDCL=0 F S DGSDCL=$O(^TMP($J,"SDAMA301",DFN,DGSDCL)) Q:'DGSDCL D Q:DGCOUNT
  1. . . S DGSDADT="" F S DGSDADT=$O(^TMP($J,"SDAMA301",DFN,DGSDCL,DGSDADT)) Q:'DGSDADT D Q:DGCOUNT
  1. . . . S DGAPPT=^TMP($J,"SDAMA301",DFN,DGSDCL,DGSDADT)
  1. . . . I $P(DGAPPT,U,15)="Y" Q ; DG*5.3*982 - quit if this is a Non-Count Clinic - no need to go to the global
  1. . . . ; DG*5.3*982 - code below added to check for Primary Care appt
  1. . . . S DGCREDIT=$P($P(DGAPPT,U,14),";",2) ;-Set the appointment's Credit Stop Code
  1. . . . S DGSTOP=$P($P(DGAPPT,U,13),";",2) ;-Set the appointment's Stop Code Number
  1. . . . ; ASF DG*5.3*1015 - remove primary clinic requirement
  1. . . . S DGCOUNT=DGCOUNT+1
  1. . . . ;I $$PCACHK^DGENACL2(DGSTOP,DGCREDIT) S DGCOUNT=DGCOUNT+1 ;-Check for a Primary Care Appointment match
  1. . I DGCOUNT=0 S SDCNT=0 ;if only non-count clinic appts. (DG*5.3*982 - or no Prim Care appt), 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