DGENA2 ;ALB/CJM,RTK,TDM,JAM,ASF,RN,JAM - Enrollment API - Automatic Update; 9/19/2002 ;1/31/03 11:54am
;;5.3;Registration;**121,122,147,232,327,469,491,779,788,824,982,993,1015,1045,1111**;Aug 13,1993;Build 18
;
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
.; DG*5.3*1045; comment out the line below. Do not use the global variable DGENRYN.
.; Instead, the PT APPLIED FOR ENROLLMENT? field is retrieved in the $$GET^DGENA
.;S:$G(DGENRYN)="" DGENRYN=$$GET1^DIQ(27.11,DGENRIEN_",",.14,"I") ;DG*5.3*993 Load new PT APPLIED FOR ENROLLMENT? field
.Q:'$$GET^DGENA(DGENRIEN,.DGENR1)
.S STATUS=$$EXT^DGENU("STATUS",DGENR1("STATUS"))
.S (DEATH,EFFDATE)=$$DEATH^DGENPTA(DFN)
.; 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
.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
.I STATUS="DECEASED",((EVENT'=1)!(DEATH)) Q
.I DEATH,'$$VET^DGENPTA(DFN) Q ;DG*5.3*993
.; DG*5.3*1045 Commented the below line to update the Not Eligible, Inelgible Date status in the Patient Enrollment file.
.;I STATUS["NOT ELIGIBLE",((EVENT'=2)!('$$VET^DGENPTA(DFN))) Q
.S:'EFFDATE EFFDATE=DT
.; DG*5.3*1045; comment out line below and replace the 9th parameter DGENRYN with DGENR1 array value
.;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
.Q:'$$CREATE^DGENA6(DFN,DGENR1("APP"),EFFDATE,DGENR1("REASON"),DGENR1("REMARKS"),.DGENR2,DGENR1("DATE"),DGENR1("END"),DGENR1("PTAPPLIED"))
.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
;
;appointment made, check if enrollment appointment request needs reset.
;if appointment cancelled, or no-show put back on call list if no appts.
I ($G(SDAMEVT)=1)!($G(SDAMEVT)=2)!($G(SDAMEVT)=3) D REQUST(SDAMEVT,SDATA)
;check-out?
Q:($G(SDAMEVT)'=5)
;
S DFN=$P($G(SDATA),"^",2)
;
;don't enroll if the patient has an enrollment record
I $$FINDCUR^DGENA(DFN) Q
;
;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
;
REQUST(SDAMEVT,SDATA) ;
;1. Check if cancelled appt. If no appts found put back on call list.
;2. Automatic collection of Appointment Request Date and Appointment
;Request Response
;- Set when Enrollment Application Date >= 8/1/2005 AND
;- Appointment Request Date is null.
;
; Input -- SDATA and SDAMEVT defined by scheduling event driver
; Output -- none
;
; $$GET1^DIQ to file #44 supported by ICR #93-A
; and file #40.07 supported by ICR #93-C (only FM read to access field 1 - not using the "C" cross reference)
N DGENRIEN,DGENR,DPTERR,DGCOM,DGADT,DFN,DGCLN
I ($G(SDAMEVT)=2)!($G(SDAMEVT)=3) G CANNS
;apointment made?
Q:($G(SDAMEVT)'=1)
;
S DFN=$P($G(SDATA),"^",2)
S DGADT=$P($G(SDATA),"^",3)
S DGCLN=$P($G(SDATA),"^",4)
;get enrollment ien
S DGENRIEN=$$FINDCUR^DGENA(DFN)
I DGENRIEN,$$GET^DGENA(DGENRIEN,.DGENR) ;set-up enrollment array
I $G(DGENR("APP"))>3050731 D
. ;and, no appointment request date. Set request="yes", request date
. I '$$GET1^DIQ(2,DFN,1010.1511,"I") D
. . ;quit if 'non-count' clinic
. . I ($$GET1^DIQ(44,DGCLN,2502,"I")="Y") Q
. . ;quit if appt. date/time < date notified of request for appointment
. . I DGADT<DT Q
. . ;set fields
. . N FDATA
. . S FDATA(2,DFN_",",1010.159)=1
. . S FDATA(2,DFN_",",1010.1511)=DT
. . D FILE^DIE("","FDATA","DPTERR")
. ;if appointment made, appt. request="yes", request status'="filled"
. ;- set request status='filled' w comment
. ; also, if non count clinic, do not file data.
. I ($$GET1^DIQ(44,DGCLN,2502,"I")="Y") Q
. I ($$GET1^DIQ(2,DFN,1010.159,"I")),($$GET1^DIQ(2,DFN,1010.161,"I")'="F") D
. . ; jam; DG*5.3*982 - If not a Primary Care appointment, do not file data
. . ; -get clinic stop codes and call logic to check for and quit if this is a Primary Care Appt.
. . N DGSCODE,DGCRCODE
. . S DGSCODE=$$GET1^DIQ(44,DGCLN,8,"I"),DGCRCODE=$$GET1^DIQ(44,DGCLN,2503,"I")
. . S DGSCODE=$$GET1^DIQ(40.7,DGSCODE,1),DGCRCODE=$$GET1^DIQ(40.7,DGCRCODE,1)
. . ; ASF DG*5.3*1015 - remove primary clinic requirement
. . ;I '$$PCACHK^DGENACL2(DGSCODE,DGCRCODE) Q
. . ;set fields
. . N FDATA
. . S FDATA(2,DFN_",",1010.161)="F"
. . S DGCOM=$$GET1^DIQ(2,DFN,1010.163)
. . 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"
. . S FDATA(2,DFN_",",1010.163)=DGCOM
. . D FILE^DIE("","FDATA","DPTERR")
Q
;
CANNS ;If appointment cancelled or no-show, no appts made, put back on call list
N DGRDTI,SDARRY,SDCNT,FDATA
;
S DFN=$P($G(SDATA),"^",2)
;
S DGRDTI=$$GET1^DIQ(2,DFN,1010.1511,"I")
I 'DGRDTI Q
S SDARRY(1)=DGRDTI_";" ;Look out from 'notify of request date' to future.
S SDARRY(3)="R;I;NT" ;appointments made
S SDARRY(4)=DFN
; jam; DG*5.3*982 - Modify this logic to add check for Primary Care Appointments. If no PCA, put on the call list
; 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)
S SDARRY("FLDS")="13;14;15"
S SDCNT=$$SDAPI^SDAMA301(.SDARRY)
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)
. N DGCOUNT,DGSDCL,DGSDADT,DGAPPT,DGCREDIT,DGSTOP
. S DGCOUNT=0 ; count clinic
. S DGSDCL=0 F S DGSDCL=$O(^TMP($J,"SDAMA301",DFN,DGSDCL)) Q:'DGSDCL D Q:DGCOUNT
. . S DGSDADT="" F S DGSDADT=$O(^TMP($J,"SDAMA301",DFN,DGSDCL,DGSDADT)) Q:'DGSDADT D Q:DGCOUNT
. . . S DGAPPT=^TMP($J,"SDAMA301",DFN,DGSDCL,DGSDADT)
. . . 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
. . . ; DG*5.3*982 - code below added to check for Primary Care appt
. . . S DGCREDIT=$P($P(DGAPPT,U,14),";",2) ;-Set the appointment's Credit Stop Code
. . . S DGSTOP=$P($P(DGAPPT,U,13),";",2) ;-Set the appointment's Stop Code Number
. . . ; ASF DG*5.3*1015 - remove primary clinic requirement
. . . S DGCOUNT=DGCOUNT+1
. . . ;I $$PCACHK^DGENACL2(DGSTOP,DGCREDIT) S DGCOUNT=DGCOUNT+1 ;-Check for a Primary Care Appointment match
. 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
I SDCNT=0 D
. S FDATA(2,DFN_",",1010.161)="@" ;delete status
. S FDATA(2,DFN_",",1010.163)="@" ;delete comment
. D FILE^DIE("","FDATA","DPTERR")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENA2 10502 printed Sep 23, 2025@20:18:10 Page 2
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
+2 ;
AUTOUPD(DFN,EVENT) ;
+1 ;Description: If the patient meets the criteria for transmission to HEC,
+2 ; he is entered to the IVM PATIENT file for future transmission.
+3 ; This procedure checks for changes in enrollment priority,
+4 ; status and fields in the eligibility sub-record. If any changes are
+5 ; found, the current enrollment record is automatically updated.
+6 ;Input:
+7 ; DFN - Patient IEN
+8 ; EVENT - Event Type (optional)
+9 ; EVENT 1 : Date of Death Deleted
+10 ; EVENT 2 : Ineligible Date Deleted
+11 ;Output: None
+12 ;
+13 ;if the eligibility/enrollment upload is in progess, do not do anything
+14 if ($GET(DGENUPLD)="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS")
QUIT
+15 ;
+16 ; If the INCOME TEST DATA (Z10) upload is in progess, do not do anything
+17 if ($GET(IVMZ10)="UPLOAD IN PROGRESS")
QUIT
+18 ;
+19 NEW DGENRIEN,DGENR1,DGENR2,STATUS,EFFDATE,OK,DEATH
+20 ;
+21 ;try to prevent problems rsulting from calling FM within FM
+22 NEW DS,D0,DO,D1,DA,DD,DS,DG,DIC,DICR,DIE,DIG,DIH,DIV,DIW,DIX,DQ,DR
+23 ;
+24 SET EVENT=+$GET(EVENT)
+25 ;
+26 DO EVENT^IVMPLOG(DFN)
+27 ;
+28 ;may drop out of block
if $$LOCK^DGENA1($GET(DFN))
Begin DoDot:1
+29 SET DGENRIEN=$$FINDCUR^DGENA(DFN)
+30 if 'DGENRIEN
QUIT
+31 ; DG*5.3*1045; comment out the line below. Do not use the global variable DGENRYN.
+32 ; Instead, the PT APPLIED FOR ENROLLMENT? field is retrieved in the $$GET^DGENA
+33 ;S:$G(DGENRYN)="" DGENRYN=$$GET1^DIQ(27.11,DGENRIEN_",",.14,"I") ;DG*5.3*993 Load new PT APPLIED FOR ENROLLMENT? field
+34 if '$$GET^DGENA(DGENRIEN,.DGENR1)
QUIT
+35 SET STATUS=$$EXT^DGENU("STATUS",DGENR1("STATUS"))
+36 SET (DEATH,EFFDATE)=$$DEATH^DGENPTA(DFN)
+37 ; 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
+38 ;DG*5.3*993 Added REGISTRATION ONLY
IF STATUS'="VERIFIED"
IF STATUS'="UNVERIFIED"
IF STATUS'="DECEASED"
IF STATUS'="REGISTRATION ONLY"
IF STATUS'["NOT ELIGIBLE"
IF STATUS'["PENDING"
IF STATUS'["DEFERRED"
QUIT
+39 IF STATUS="DECEASED"
IF ((EVENT'=1)!(DEATH))
QUIT
+40 ;DG*5.3*993
IF DEATH
IF '$$VET^DGENPTA(DFN)
QUIT
+41 ; DG*5.3*1045 Commented the below line to update the Not Eligible, Inelgible Date status in the Patient Enrollment file.
+42 ;I STATUS["NOT ELIGIBLE",((EVENT'=2)!('$$VET^DGENPTA(DFN))) Q
+43 if 'EFFDATE
SET EFFDATE=DT
+44 ; DG*5.3*1045; comment out line below and replace the 9th parameter DGENRYN with DGENR1 array value
+45 ;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
+46 if '$$CREATE^DGENA6(DFN,DGENR1("APP"),EFFDATE,DGENR1("REASON"),DGENR1("REMARKS"),.DGENR2,DGENR1("DATE"),DGENR1("END"),DGENR1("PTAPPLIED"))
QUIT
+47 SET OK=1
+48 if (DGENR1("PRIORITY")'=DGENR2("PRIORITY"))!(DGENR2("STATUS")'=DGENR1("STATUS"))
SET OK=0
+49 IF OK
Begin DoDot:2
+50 NEW SUB
+51 SET SUB=""
+52 FOR
SET SUB=$ORDER(DGENR2("ELIG",SUB))
if SUB=""
QUIT
if (DGENR1("ELIG",SUB)'=DGENR2("ELIG",SUB))
SET OK=0
End DoDot:2
+53 IF 'OK
Begin DoDot:2
+54 IF (DGENR1("EFFDATE")=DGENR2("EFFDATE"))
IF (DGENR1("SOURCE")=DGENR2("SOURCE"))
IF (DGENR1("USER")=DGENR2("USER"))
IF (DGENR1("DATETIME")\1)=(DGENR2("DATETIME")\1)
Begin DoDot:3
+55 ;in this case it's an overlay
+56 SET DGENR2("PRIORREC")=DGENR1("PRIORREC")
+57 IF $$EDITCUR^DGENA1(.DGENR2)
End DoDot:3
+58 IF '$TEST
Begin DoDot:3
+59 ;in this case create a new record, to preserve the audit trail
+60 IF $$STORECUR^DGENA1(.DGENR2)
End DoDot:3
End DoDot:2
End DoDot:1
+61 DO UNLOCK^DGENA1($GET(DFN))
+62 QUIT
MTUPD ;
+1 ;Description - entry point for Means Test Event Driver for Enrollment
+2 ;
+3 DO AUTOUPD($GET(DFN))
+4 QUIT
+5 ;
SDDIS ;Entry point for the DGEN SD DISPLAY CURRENT ENROLLMENT protocol,
+1 ;which hangs of the Scheduling Event Driver
+2 ;
+3 NEW DFN
SET DFN=$PIECE($GET(SDATA),"^",2)
+4 ;
+5 ;don't display if running in the background
+6 if $DATA(ZTQUEUED)
QUIT
+7 ;
+8 ;don't want to display enrollment for non-vets with no enrollment status
+9 if ('$$VET^DGENPTA(DFN))&('$$STATUS^DGENA(DFN))
QUIT
+10 ;
+11 ;if making an appt., & in interactive mode, display enrollment status
+12 IF ($GET(SDAMEVT)=1)
IF $GET(SDMODE)=0
Begin DoDot:1
+13 DO DISPLAY^DGENU($PIECE($GET(SDATA),"^",2))
+14 DO PAUSE^VALM1
End DoDot:1
+15 ;
+16 ;want to do the same thing for check-in, unless appt just made
+17 IF ($GET(SDAMEVT)=4)
IF $GET(SDMODE)=0
Begin DoDot:1
+18 ;want to try avoiding giving display if it was done already
+19 ;so, if it is an unscheduled appt made today, skip
+20 NEW PTNODE,SCNODE
+21 SET SCNODE=$GET(^TMP("SDAMEVT",$JOB,"AFTER","SC"))
+22 SET PTNODE=$GET(^TMP("SDAMEVT",$JOB,"AFTER","DPT"))
+23 ;unscheduled appt made today
IF +$PIECE(SCNODE,"^",7)=$GET(DT)
IF $PIECE(PTNODE,"^",7)=4
QUIT
+24 DO DISPLAY^DGENU($PIECE($GET(SDATA),"^",2))
+25 DO PAUSE^VALM1
End DoDot:1
+26 QUIT
+27 ;
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
+2 ;if there is no prior enrollment record.
+3 ;
+4 ; Input -- SDATA & SDAMEVT defined by the scheduling event driver
+5 ; Output -- none
+6 ;
+7 NEW DGENR,DFN
+8 ;
+9 ;NOTE - it appears from testing that means test status REQUIRED is set
+10 ;within scheduling, obviating the need to do it here. This is why
+11 ;several lines are commented out.
+12 ;
+13 ;N DGENR,DGOKF,DGREQF,DFN,DGMSGF,DG,DGMT,DGMTCOR,DGMTE,DGRGAUTO,DGWRT,XMZ,DIG,DIH
+14 ;
+15 ;appointment made, check if enrollment appointment request needs reset.
+16 ;if appointment cancelled, or no-show put back on call list if no appts.
+17 IF ($GET(SDAMEVT)=1)!($GET(SDAMEVT)=2)!($GET(SDAMEVT)=3)
DO REQUST(SDAMEVT,SDATA)
+18 ;check-out?
+19 if ($GET(SDAMEVT)'=5)
QUIT
+20 ;
+21 SET DFN=$PIECE($GET(SDATA),"^",2)
+22 ;
+23 ;don't enroll if the patient has an enrollment record
+24 IF $$FINDCUR^DGENA(DFN)
QUIT
+25 ;
+26 ;non-vet?
+27 if '$$VET^DGENPTA(DFN)
QUIT
+28 ;
+29 ;dead?
+30 if $$DEATH^DGENPTA(DFN)
QUIT
+31 ;
+32 ;Does patient require a Means Test?
+33 ;S DGMSGF=1
+34 ;D EN^DGMTR
+35 ;
+36 ;Create local enrollment array
+37 IF $$CREATE^DGENA6(DFN,DT,,,,.DGENR)
Begin DoDot:1
+38 ;
+39 ;Store local enrollment as current
+40 IF $$STORECUR^DGENA1(.DGENR)
Begin DoDot:2
+41 ;
+42 ;If patient's means test status is required, send bulletin
+43 ;I $$MTREQ^DGEN(DFN) D MTBULL^DGEN(DFN,.DGENR)
End DoDot:2
End DoDot:1
+44 QUIT
+45 ;
REQUST(SDAMEVT,SDATA) ;
+1 ;1. Check if cancelled appt. If no appts found put back on call list.
+2 ;2. Automatic collection of Appointment Request Date and Appointment
+3 ;Request Response
+4 ;- Set when Enrollment Application Date >= 8/1/2005 AND
+5 ;- Appointment Request Date is null.
+6 ;
+7 ; Input -- SDATA and SDAMEVT defined by scheduling event driver
+8 ; Output -- none
+9 ;
+10 ; $$GET1^DIQ to file #44 supported by ICR #93-A
+11 ; and file #40.07 supported by ICR #93-C (only FM read to access field 1 - not using the "C" cross reference)
+12 NEW DGENRIEN,DGENR,DPTERR,DGCOM,DGADT,DFN,DGCLN
+13 IF ($GET(SDAMEVT)=2)!($GET(SDAMEVT)=3)
GOTO CANNS
+14 ;apointment made?
+15 if ($GET(SDAMEVT)'=1)
QUIT
+16 ;
+17 SET DFN=$PIECE($GET(SDATA),"^",2)
+18 SET DGADT=$PIECE($GET(SDATA),"^",3)
+19 SET DGCLN=$PIECE($GET(SDATA),"^",4)
+20 ;get enrollment ien
+21 SET DGENRIEN=$$FINDCUR^DGENA(DFN)
+22 ;set-up enrollment array
IF DGENRIEN
IF $$GET^DGENA(DGENRIEN,.DGENR)
+23 IF $GET(DGENR("APP"))>3050731
Begin DoDot:1
+24 ;and, no appointment request date. Set request="yes", request date
+25 IF '$$GET1^DIQ(2,DFN,1010.1511,"I")
Begin DoDot:2
+26 ;quit if 'non-count' clinic
+27 IF ($$GET1^DIQ(44,DGCLN,2502,"I")="Y")
QUIT
+28 ;quit if appt. date/time < date notified of request for appointment
+29 IF DGADT<DT
QUIT
+30 ;set fields
+31 NEW FDATA
+32 SET FDATA(2,DFN_",",1010.159)=1
+33 SET FDATA(2,DFN_",",1010.1511)=DT
+34 DO FILE^DIE("","FDATA","DPTERR")
End DoDot:2
+35 ;if appointment made, appt. request="yes", request status'="filled"
+36 ;- set request status='filled' w comment
+37 ; also, if non count clinic, do not file data.
+38 IF ($$GET1^DIQ(44,DGCLN,2502,"I")="Y")
QUIT
+39 IF ($$GET1^DIQ(2,DFN,1010.159,"I"))
IF ($$GET1^DIQ(2,DFN,1010.161,"I")'="F")
Begin DoDot:2
+40 ; jam; DG*5.3*982 - If not a Primary Care appointment, do not file data
+41 ; -get clinic stop codes and call logic to check for and quit if this is a Primary Care Appt.
+42 NEW DGSCODE,DGCRCODE
+43 SET DGSCODE=$$GET1^DIQ(44,DGCLN,8,"I")
SET DGCRCODE=$$GET1^DIQ(44,DGCLN,2503,"I")
+44 SET DGSCODE=$$GET1^DIQ(40.7,DGSCODE,1)
SET DGCRCODE=$$GET1^DIQ(40.7,DGCRCODE,1)
+45 ; ASF DG*5.3*1015 - remove primary clinic requirement
+46 ;I '$$PCACHK^DGENACL2(DGSCODE,DGCRCODE) Q
+47 ;set fields
+48 NEW FDATA
+49 SET FDATA(2,DFN_",",1010.161)="F"
+50 SET DGCOM=$$GET1^DIQ(2,DFN,1010.163)
+51 SET DGCOM=DGCOM_$SELECT(DGCOM'="":"<>",1:"")_"AutoComm:"_$SELECT($$GET1^DIQ(2,DFN,1010.161,"I")="":"null",1:$SELECT($$GET1^DIQ(2,DFN,1010.161,"I")="I":"IN PROGRESS",1:$$GET1^DIQ(2,DFN,1010.161)))_"|FILLED by Scheduling"
+52 SET FDATA(2,DFN_",",1010.163)=DGCOM
+53 DO FILE^DIE("","FDATA","DPTERR")
End DoDot:2
End DoDot:1
+54 QUIT
+55 ;
CANNS ;If appointment cancelled or no-show, no appts made, put back on call list
+1 NEW DGRDTI,SDARRY,SDCNT,FDATA
+2 ;
+3 SET DFN=$PIECE($GET(SDATA),"^",2)
+4 ;
+5 SET DGRDTI=$$GET1^DIQ(2,DFN,1010.1511,"I")
+6 IF 'DGRDTI
QUIT
+7 ;Look out from 'notify of request date' to future.
SET SDARRY(1)=DGRDTI_";"
+8 ;appointments made
SET SDARRY(3)="R;I;NT"
+9 SET SDARRY(4)=DFN
+10 ; jam; DG*5.3*982 - Modify this logic to add check for Primary Care Appointments. If no PCA, put on the call list
+11 ; 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)
+12 SET SDARRY("FLDS")="13;14;15"
+13 SET SDCNT=$$SDAPI^SDAMA301(.SDARRY)
+14 ;If only non-count clinic appts. put on call list, (DG*5.3*982 - or if no Primary Care appts, put on call list)
IF SDCNT>0
Begin DoDot:1
+15 NEW DGCOUNT,DGSDCL,DGSDADT,DGAPPT,DGCREDIT,DGSTOP
+16 ; count clinic
SET DGCOUNT=0
+17 SET DGSDCL=0
FOR
SET DGSDCL=$ORDER(^TMP($JOB,"SDAMA301",DFN,DGSDCL))
if 'DGSDCL
QUIT
Begin DoDot:2
+18 SET DGSDADT=""
FOR
SET DGSDADT=$ORDER(^TMP($JOB,"SDAMA301",DFN,DGSDCL,DGSDADT))
if 'DGSDADT
QUIT
Begin DoDot:3
+19 SET DGAPPT=^TMP($JOB,"SDAMA301",DFN,DGSDCL,DGSDADT)
+20 ; DG*5.3*982 - quit if this is a Non-Count Clinic - no need to go to the global
IF $PIECE(DGAPPT,U,15)="Y"
QUIT
+21 ; DG*5.3*982 - code below added to check for Primary Care appt
+22 ;-Set the appointment's Credit Stop Code
SET DGCREDIT=$PIECE($PIECE(DGAPPT,U,14),";",2)
+23 ;-Set the appointment's Stop Code Number
SET DGSTOP=$PIECE($PIECE(DGAPPT,U,13),";",2)
+24 ; ASF DG*5.3*1015 - remove primary clinic requirement
+25 SET DGCOUNT=DGCOUNT+1
+26 ;I $$PCACHK^DGENACL2(DGSTOP,DGCREDIT) S DGCOUNT=DGCOUNT+1 ;-Check for a Primary Care Appointment match
End DoDot:3
if DGCOUNT
QUIT
End DoDot:2
if DGCOUNT
QUIT
+27 ;if only non-count clinic appts. (DG*5.3*982 - or no Prim Care appt), put on call list
IF DGCOUNT=0
SET SDCNT=0
End DoDot:1
+28 IF SDCNT=0
Begin DoDot:1
+29 ;delete status
SET FDATA(2,DFN_",",1010.161)="@"
+30 ;delete comment
SET FDATA(2,DFN_",",1010.163)="@"
+31 DO FILE^DIE("","FDATA","DPTERR")
End DoDot:1
+32 QUIT
