DGEN ;ALB/RMO/CJM - Patient Enrollment Option; 11/17/00 12:12pm ; 12/6/00 5:32pm
;;5.3;Registration;**121,122,165,147,232,314,624,1015**;Aug 13,1993;Build 21
;
EN ;Entry point for stand-alone enrollment option
; Input -- None
; Output -- None
N DFN
;
;Get Patient file (#2) IEN - DFN
D GETPAT^DGRPTU(,,.DFN,) G ENQ:DFN<0
;
;Load patient enrollment screen
D EN^DGENL(DFN)
ENQ Q
;
EN1(DFN) ;Entry point for enrollment from registration and disposition
; Input -- DFN Patient IEN
; Output -- None
N DGENOUT
;
;Check if patient should be asked to enroll
I $$CHK(DFN) D
. ;Enroll patient
. I $$ENRPAT(DFN,.DGENOUT)
;
;If user did not timeout or '^' and
;patient is an eligible veteran or has an enrollment status
I '$G(DGENOUT),($$VET^DGENPTA(DFN)!($$STATUS^DGENA(DFN))) D
. ;Display enrollment
. D DISPLAY^DGENU(DFN)
EN1Q Q
;
CHK(DFN) ;Check if patient should be asked to enroll
; Input -- DFN Patient IEN
; Output -- 1=Yes and 0=No
N Y,STATUS
S Y=1
;Is patient an eligible veteran
S Y=$$VET^DGENPTA(DFN)
;
;Is patient already enrolled or pending enrollment
S STATUS=$$STATUS^DGENA(DFN)
; Purple Heart added status 21
I Y,(STATUS=9)!(STATUS=1)!(STATUS=2)!(STATUS=14)!(STATUS=15)!(STATUS=16)!(STATUS=17)!(STATUS=18)!(STATUS=21) S Y=0
Q +$G(Y)
;
ENRPAT(DFN,DGENOUT) ;Enroll patient
; Input -- DFN Patient IEN
; Output -- 1=Successful and 0=Failure
; DGENOUT 1=Timeout or up-arrow
N DGOKF
;Ask patient if s/he would like to enroll
I $$ASK("enroll",.DGENOUT) D
. ;If 'Yes' enroll patient
. S DGOKF=$$ENROLL(DFN)
ELSE D
. ;Quit if timeout or '^'
. Q:$G(DGENOUT)
. ;Otherwise patient declined enrollment
. ;Cancel/decline functionality disabled by DG*5.3*232
. ;S DGOKF=$$DECLINE(DFN,DT)
. S DGOKF=0
. ;* Prompt for requested appt. (DG*5.3*624)
. I $P($G(^DPT(DFN,1010.15)),"^",9)="" DO
. . N DGSXS,DGAPPTAN
. . S DGSXS=$$PROMPT^DGENU(2,1010.159,1,.DGAPPTAN,"",1)
. . I DGSXS DO
. . . N DA,DR,DIE
. . . S DA=DFN
. . . S DIE="^DPT("
. . . S DR="1010.159////^S X=DGAPPTAN"
. . . D ^DIE
. . . K DA,DR,DIE
. . . ;*Set Appointment Request Date to current date
. . . N DA,DR,DIE
. . . S DIE="^DPT("
. . . S DA=DFN
. . . S DR="1010.1511////^S X=DT"
. . . D ^DIE
. . . K DA,DR,DIE
ENRPATQ Q +$G(DGOKF)
;
ASK(ACTION,DGENOUT) ;Ask patient if s/he would like to enroll or cease enrollment
; Input -- ACTION Action description
; Output -- 1=Yes and 0=No
; DGENOUT 1=Timeout or up-arrow
N DIR,DTOUT,DUOUT,Y
S DIR("A")="Do you wish to "_ACTION_" in the VA Patient Enrollment System"
S DIR("B")="YES",DIR(0)="Y"
W ! D ^DIR
I $D(DTOUT)!($D(DUOUT)) S DGENOUT=1
Q +$G(Y)
;
ENROLL(DFN) ;Create new local unverified enrollment
; Input -- DFN Patient IEN
; Output -- 1=Successful and 0=Failure
N DGENR,DGOKF,DGREQF,APPDATE
;Lock enrollment record
I '$$LOCK^DGENA1(DFN) D G ENROLLQ
. W !,">>> Another user is editing, try later ..."
. D PAUSE^VALM1
;
;now that the enrollment history is locked, need to check again whether or not patient may be enrolled (query reply may have been received)
G:'$$CHK^DGEN(DFN) ENROLLQ
;
;Ask Application Date
W !
I $$PROMPT^DGENU(27.11,.01,DT,.APPDATE) D
. ;Does patient require a Means Test?
. D EN^DGMTR
. ;Create local enrollment array
. I $$CREATE^DGENA6(DFN,APPDATE,,,,.DGENR) D
. . ;Store local enrollment as current
. . I $$STORECUR^DGENA1(.DGENR) D
. . . S DGOKF=1
. . . ;Ask preferred facility
. . . D PREFER^DGENPT(DFN)
. . . ;If patient's means test status is required, send bulletin
. . . I $$MTREQ(DFN) D MTBULL(DFN,.DGENR)
I $P($G(^DPT(DFN,1010.15)),"^",11)="" DO
. N DGSXS,DGAPPTAN,DGDFLT
. S DGDFLT=$P($G(^DPT(DFN,1010.15)),"^",9)
. S:DGDFLT="" DGDFLT=1
. S DGSXS=$$PROMPT^DGENU(2,1010.159,DGDFLT,.DGAPPTAN,"",1)
. I DGSXS DO
. . N DA,DR,DIE
. . S DA=DFN
. . S DIE="^DPT("
. . S DR="1010.159////^S X=DGAPPTAN"
. . D ^DIE
. . K DA,DR,DIE
. . ;*If patient answered NO to "Do you want an appt" question
. . I $P($G(^DPT(DFN,1010.15)),"^",9)=0 DO
. . . N DA,DR,DIE
. . . S DIE="^DPT("
. . . S DA=DFN
. . . S DR="1010.1511////^S X=DT"
. . . D ^DIE
. . . K DA,DR,DIE
. . ;*If patient answered YES to "Do you want an appt" question
. . I $P($G(^DPT(DFN,1010.15)),"^",9)=1 DO
. . . N DA,DR,DIE
. . . S DIE="^DPT("
. . . S DA=DFN
. . . S DR="1010.1511////^S X=APPDATE"
. . . D ^DIE
. . . K DA,DR,DIE
ENROLLQ D UNLOCK^DGENA1(DFN)
Q +$G(DGOKF)
;
CANCEL(DFN,DGENR,EFFDATE) ;Cancel current enrollment
; Input
; DFN Patient IEN
; DGENR Array containing current enrollment (pass by reference)
; EFFDATE Enrollment Effective Date Of Change (optional)
; Output
; Function Return Value is 1 if Successful and 0 on Failure
;
N DGENR2,DGOKF,REASON,REMARKS,BEGIN,END,ERRMSG
;Lock enrollment record
I '$$LOCK^DGENA1(DFN) D G CANCELQ
.W !,">>> Another user is editing, try later ..."
.D PAUSE^VALM1
W !
;Ask effective date of change for cessation
I '$G(EFFDATE) D G:'EFFDATE CANCELQ
.N DIR
.S BEGIN=$S(DGENR("DATE"):DGENR("DATE"),1:DGENR("APP"))
.S END=DGENR("END")
.S DIR(0)="D^::AEX"
.S DIR("A")="Effective Date of Cancellation"
.S DIR("B")=$$VIEWDATE(DT)
ASKDATE .W !,"Please enter the date to cease enrollment, no earlier than "_$$VIEWDATE(BEGIN)
.I END W !,"and no later than "_$$VIEWDATE(END)_"."
.D ^DIR
.I $D(DIRUT)!('Y) S EFFDATE="" Q
.E S EFFDATE=Y I (EFFDATE<BEGIN)!(END&(END<EFFDATE)) G ASKDATE
.;
;Ask reason canceled/declined enrollment
I '$$PROMPT^DGENU(27.11,.05,,.REASON,1) G CANCELQ
;If reason is 'Other', ask for remarks
I REASON=4,'$$PROMPT^DGENU(27.11,25,,.REMARKS,1) G CANCELQ
;Create local enrollment array
I $$CREATE^DGENA6(DFN,DGENR("APP"),EFFDATE,REASON,$G(REMARKS),.DGENR2,DGENR("DATE"),EFFDATE) D
.;Store local enrollment as current
.I $$STORECUR^DGENA1(.DGENR2,,.ERRMSG) D
..S DGOKF=1
.E D
..W !,$G(ERRMSG)
;
D UNLOCK^DGENA1(DFN)
CANCELQ Q +$G(DGOKF)
;
DECLINE(DFN,APPDATE) ;Create Declined enrollment
; Input -- DFN Patient IEN
; APPDATE Application date (optional)
; Output -- 1=Successful and 0=Failure
N DGENR,DGOKF,REASON,REMARKS
;Lock enrollment record
I '$$LOCK^DGENA1(DFN) D G DECLINEQ
. W !,">>> Another user is editing, try later ..."
. D PAUSE^VALM1
;Ask enrollment date
W !
I '$G(APPDATE),'$$PROMPT^DGENU(27.11,.01,DT,.APPDATE) G DECLINEQ
;Ask reason declined enrollment
I '$$PROMPT^DGENU(27.11,.05,,.REASON,1) G DECLINEQ
;If reason is 'Other', ask for remarks
I REASON=4,'$$PROMPT^DGENU(27.11,25,,.REMARKS,1) G DECLINEQ
;Create local enrollment array
I $$CREATE^DGENA6(DFN,APPDATE,DT,REASON,$G(REMARKS),.DGENR) D
. ;Store local enrollment as current
. I $$STORECUR^DGENA1(.DGENR) D
. . S DGOKF=1
. . ;Ask preferred facility
. . D PREFER^DGENPT(DFN)
D UNLOCK^DGENA1(DFN)
DECLINEQ ;
Q +$G(DGOKF)
;
MTBULL(DFN,DGENR) ;Create/Send means test 'REQUIRED' bulletin for PATIENT ENROLLMENT
;
; Input:
; DFN - patient IEN
; DGENR - this local array represents the PATIENT ENROLLMENT and
; should be passed by reference
;
; Output: None
;
N DGBULL,DGLINE,DGMGRP,DGNAME,DIFROM,VA,VAERR,XMTEXT,XMSUB,XMDUZ
;
; get Means Test 'Required' mail group
S DGMGRP=$P($G(^DG(43,1,"NOT")),"^",13)
;
; if mail group not defined, exit
I 'DGMGRP G MTBULLQ
;
; set up XMY array
D XMY^DGMTUTL(DGMGRP,0,1)
;
; obtain patient identifier
D PID^VADPT6
;
; patient name
S DGNAME=$P($G(^DPT(DFN,0)),"^")
;
; local array containing msg text
S XMTEXT="DGBULL("
;
; - msg subject
S XMSUB=$E("Patient: "_DGNAME,1,30)_" ("_VA("BID")_") "_"Means Test Required"
;
; - insert lines of text into message
S DGLINE=0
D LINE("The following patient is enrolled in the VA Patient Enrollment",.DGLINE)
D LINE("System and 'REQUIRES' a means test.",.DGLINE)
D LINE("",.DGLINE)
D LINE(" Patient Name: "_DGNAME,.DGLINE)
D LINE(" Patient ID: "_VA("PID"),.DGLINE)
D LINE("",.DGLINE)
D LINE(" Enrollment Date: "_$$EXT^DGENU("DATE",DGENR("DATE")),.DGLINE)
D LINE(" Enrollment Status: "_$$EXT^DGENU("STATUS",DGENR("STATUS")),.DGLINE)
D LINE(" Entered By: "_$$EXT^DGENU("USER",DGENR("USER")),.DGLINE)
D LINE(" Date/Time Entered: "_$$EXT^DGENU("DATETIME",DGENR("DATETIME")),.DGLINE)
D ^XMD
;
MTBULLQ Q
;
LINE(DGTEXT,DGLINE) ;Add lines of text to mail message
;
; Input:
; DGTEXT - as line of text to be inserted into mail message
; DGLINE - as number of lines in message, passed by reference
;
; Output:
; DGBULL - as local array containing message text
;
S DGLINE=DGLINE+1
S DGBULL(DGLINE)=DGTEXT
Q
;
MTREQ(DFN) ; --
;Determine if Means Test (required) bulletin should be sent for patient.
;
; Input:
; DFN - patient IEN
;
; Output:
; 1=Successful and 0=Failure
;
N DGMTNODE,DGMTREQ
;
;Last means test for patient
S DGMTNODE=$$LST^DGMTU(DFN)
;
;If scheduling bulletin already sent, exit
I $P($G(^DGMT(408.31,+DGMTNODE,"BUL")),"^")=DT G MTREQQ
;
;If patient means test status is 'REQUIRED'
I $P(DGMTNODE,"^",4)="R" D
. ;set flag (send bulletin)
. S DGMTREQ=1
;
MTREQQ Q +$G(DGMTREQ)
;
VIEWDATE(FMDATE) ;
;This function changes a FM date to its external representation
N Y
S Y=$G(FMDATE)
D DD^%DT
Q Y
DGEN ;ALB/RMO/CJM - Patient Enrollment Option; 11/17/00 12:12pm ; 12/6/00 5:32pm
+1 ;;5.3;Registration;**121,122,165,147,232,314,624,1015**;Aug 13,1993;Build 21
+2 ;
EN ;Entry point for stand-alone enrollment option
+1 ; Input -- None
+2 ; Output -- None
+3 NEW DFN
+4 ;
+5 ;Get Patient file (#2) IEN - DFN
+6 DO GETPAT^DGRPTU(,,.DFN,)
IF DFN<0
GOTO ENQ
+7 ;
+8 ;Load patient enrollment screen
+9 DO EN^DGENL(DFN)
ENQ QUIT
+1 ;
EN1(DFN) ;Entry point for enrollment from registration and disposition
+1 ; Input -- DFN Patient IEN
+2 ; Output -- None
+3 NEW DGENOUT
+4 ;
+5 ;Check if patient should be asked to enroll
+6 IF $$CHK(DFN)
Begin DoDot:1
+7 ;Enroll patient
+8 IF $$ENRPAT(DFN,.DGENOUT)
End DoDot:1
+9 ;
+10 ;If user did not timeout or '^' and
+11 ;patient is an eligible veteran or has an enrollment status
+12 IF '$GET(DGENOUT)
IF ($$VET^DGENPTA(DFN)!($$STATUS^DGENA(DFN)))
Begin DoDot:1
+13 ;Display enrollment
+14 DO DISPLAY^DGENU(DFN)
End DoDot:1
EN1Q QUIT
+1 ;
CHK(DFN) ;Check if patient should be asked to enroll
+1 ; Input -- DFN Patient IEN
+2 ; Output -- 1=Yes and 0=No
+3 NEW Y,STATUS
+4 SET Y=1
+5 ;Is patient an eligible veteran
+6 SET Y=$$VET^DGENPTA(DFN)
+7 ;
+8 ;Is patient already enrolled or pending enrollment
+9 SET STATUS=$$STATUS^DGENA(DFN)
+10 ; Purple Heart added status 21
+11 IF Y
IF (STATUS=9)!(STATUS=1)!(STATUS=2)!(STATUS=14)!(STATUS=15)!(STATUS=16)!(STATUS=17)!(STATUS=18)!(STATUS=21)
SET Y=0
+12 QUIT +$GET(Y)
+13 ;
ENRPAT(DFN,DGENOUT) ;Enroll patient
+1 ; Input -- DFN Patient IEN
+2 ; Output -- 1=Successful and 0=Failure
+3 ; DGENOUT 1=Timeout or up-arrow
+4 NEW DGOKF
+5 ;Ask patient if s/he would like to enroll
+6 IF $$ASK("enroll",.DGENOUT)
Begin DoDot:1
+7 ;If 'Yes' enroll patient
+8 SET DGOKF=$$ENROLL(DFN)
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 ;Quit if timeout or '^'
+11 IF $GET(DGENOUT)
QUIT
+12 ;Otherwise patient declined enrollment
+13 ;Cancel/decline functionality disabled by DG*5.3*232
+14 ;S DGOKF=$$DECLINE(DFN,DT)
+15 SET DGOKF=0
+16 ;* Prompt for requested appt. (DG*5.3*624)
+17 IF $PIECE($GET(^DPT(DFN,1010.15)),"^",9)=""
Begin DoDot:2
+18 NEW DGSXS,DGAPPTAN
+19 SET DGSXS=$$PROMPT^DGENU(2,1010.159,1,.DGAPPTAN,"",1)
+20 IF DGSXS
Begin DoDot:3
+21 NEW DA,DR,DIE
+22 SET DA=DFN
+23 SET DIE="^DPT("
+24 SET DR="1010.159////^S X=DGAPPTAN"
+25 DO ^DIE
+26 KILL DA,DR,DIE
+27 ;*Set Appointment Request Date to current date
+28 NEW DA,DR,DIE
+29 SET DIE="^DPT("
+30 SET DA=DFN
+31 SET DR="1010.1511////^S X=DT"
+32 DO ^DIE
+33 KILL DA,DR,DIE
End DoDot:3
End DoDot:2
End DoDot:1
ENRPATQ QUIT +$GET(DGOKF)
+1 ;
ASK(ACTION,DGENOUT) ;Ask patient if s/he would like to enroll or cease enrollment
+1 ; Input -- ACTION Action description
+2 ; Output -- 1=Yes and 0=No
+3 ; DGENOUT 1=Timeout or up-arrow
+4 NEW DIR,DTOUT,DUOUT,Y
+5 SET DIR("A")="Do you wish to "_ACTION_" in the VA Patient Enrollment System"
+6 SET DIR("B")="YES"
SET DIR(0)="Y"
+7 WRITE !
DO ^DIR
+8 IF $DATA(DTOUT)!($DATA(DUOUT))
SET DGENOUT=1
+9 QUIT +$GET(Y)
+10 ;
ENROLL(DFN) ;Create new local unverified enrollment
+1 ; Input -- DFN Patient IEN
+2 ; Output -- 1=Successful and 0=Failure
+3 NEW DGENR,DGOKF,DGREQF,APPDATE
+4 ;Lock enrollment record
+5 IF '$$LOCK^DGENA1(DFN)
Begin DoDot:1
+6 WRITE !,">>> Another user is editing, try later ..."
+7 DO PAUSE^VALM1
End DoDot:1
GOTO ENROLLQ
+8 ;
+9 ;now that the enrollment history is locked, need to check again whether or not patient may be enrolled (query reply may have been received)
+10 IF '$$CHK^DGEN(DFN)
GOTO ENROLLQ
+11 ;
+12 ;Ask Application Date
+13 WRITE !
+14 IF $$PROMPT^DGENU(27.11,.01,DT,.APPDATE)
Begin DoDot:1
+15 ;Does patient require a Means Test?
+16 DO EN^DGMTR
+17 ;Create local enrollment array
+18 IF $$CREATE^DGENA6(DFN,APPDATE,,,,.DGENR)
Begin DoDot:2
+19 ;Store local enrollment as current
+20 IF $$STORECUR^DGENA1(.DGENR)
Begin DoDot:3
+21 SET DGOKF=1
+22 ;Ask preferred facility
+23 DO PREFER^DGENPT(DFN)
+24 ;If patient's means test status is required, send bulletin
+25 IF $$MTREQ(DFN)
DO MTBULL(DFN,.DGENR)
End DoDot:3
End DoDot:2
End DoDot:1
+26 IF $PIECE($GET(^DPT(DFN,1010.15)),"^",11)=""
Begin DoDot:1
+27 NEW DGSXS,DGAPPTAN,DGDFLT
+28 SET DGDFLT=$PIECE($GET(^DPT(DFN,1010.15)),"^",9)
+29 IF DGDFLT=""
SET DGDFLT=1
+30 SET DGSXS=$$PROMPT^DGENU(2,1010.159,DGDFLT,.DGAPPTAN,"",1)
+31 IF DGSXS
Begin DoDot:2
+32 NEW DA,DR,DIE
+33 SET DA=DFN
+34 SET DIE="^DPT("
+35 SET DR="1010.159////^S X=DGAPPTAN"
+36 DO ^DIE
+37 KILL DA,DR,DIE
+38 ;*If patient answered NO to "Do you want an appt" question
+39 IF $PIECE($GET(^DPT(DFN,1010.15)),"^",9)=0
Begin DoDot:3
+40 NEW DA,DR,DIE
+41 SET DIE="^DPT("
+42 SET DA=DFN
+43 SET DR="1010.1511////^S X=DT"
+44 DO ^DIE
+45 KILL DA,DR,DIE
End DoDot:3
+46 ;*If patient answered YES to "Do you want an appt" question
+47 IF $PIECE($GET(^DPT(DFN,1010.15)),"^",9)=1
Begin DoDot:3
+48 NEW DA,DR,DIE
+49 SET DIE="^DPT("
+50 SET DA=DFN
+51 SET DR="1010.1511////^S X=APPDATE"
+52 DO ^DIE
+53 KILL DA,DR,DIE
End DoDot:3
End DoDot:2
End DoDot:1
ENROLLQ DO UNLOCK^DGENA1(DFN)
+1 QUIT +$GET(DGOKF)
+2 ;
CANCEL(DFN,DGENR,EFFDATE) ;Cancel current enrollment
+1 ; Input
+2 ; DFN Patient IEN
+3 ; DGENR Array containing current enrollment (pass by reference)
+4 ; EFFDATE Enrollment Effective Date Of Change (optional)
+5 ; Output
+6 ; Function Return Value is 1 if Successful and 0 on Failure
+7 ;
+8 NEW DGENR2,DGOKF,REASON,REMARKS,BEGIN,END,ERRMSG
+9 ;Lock enrollment record
+10 IF '$$LOCK^DGENA1(DFN)
Begin DoDot:1
+11 WRITE !,">>> Another user is editing, try later ..."
+12 DO PAUSE^VALM1
End DoDot:1
GOTO CANCELQ
+13 WRITE !
+14 ;Ask effective date of change for cessation
+15 IF '$GET(EFFDATE)
Begin DoDot:1
+16 NEW DIR
+17 SET BEGIN=$SELECT(DGENR("DATE"):DGENR("DATE"),1:DGENR("APP"))
+18 SET END=DGENR("END")
+19 SET DIR(0)="D^::AEX"
+20 SET DIR("A")="Effective Date of Cancellation"
+21 SET DIR("B")=$$VIEWDATE(DT)
ASKDATE WRITE !,"Please enter the date to cease enrollment, no earlier than "_$$VIEWDATE(BEGIN)
+1 IF END
WRITE !,"and no later than "_$$VIEWDATE(END)_"."
+2 DO ^DIR
+3 IF $DATA(DIRUT)!('Y)
SET EFFDATE=""
QUIT
+4 IF '$TEST
SET EFFDATE=Y
IF (EFFDATE<BEGIN)!(END&(END<EFFDATE))
GOTO ASKDATE
+5 ;
End DoDot:1
IF 'EFFDATE
GOTO CANCELQ
+6 ;Ask reason canceled/declined enrollment
+7 IF '$$PROMPT^DGENU(27.11,.05,,.REASON,1)
GOTO CANCELQ
+8 ;If reason is 'Other', ask for remarks
+9 IF REASON=4
IF '$$PROMPT^DGENU(27.11,25,,.REMARKS,1)
GOTO CANCELQ
+10 ;Create local enrollment array
+11 IF $$CREATE^DGENA6(DFN,DGENR("APP"),EFFDATE,REASON,$GET(REMARKS),.DGENR2,DGENR("DATE"),EFFDATE)
Begin DoDot:1
+12 ;Store local enrollment as current
+13 IF $$STORECUR^DGENA1(.DGENR2,,.ERRMSG)
Begin DoDot:2
+14 SET DGOKF=1
End DoDot:2
+15 IF '$TEST
Begin DoDot:2
+16 WRITE !,$GET(ERRMSG)
End DoDot:2
End DoDot:1
+17 ;
+18 DO UNLOCK^DGENA1(DFN)
CANCELQ QUIT +$GET(DGOKF)
+1 ;
DECLINE(DFN,APPDATE) ;Create Declined enrollment
+1 ; Input -- DFN Patient IEN
+2 ; APPDATE Application date (optional)
+3 ; Output -- 1=Successful and 0=Failure
+4 NEW DGENR,DGOKF,REASON,REMARKS
+5 ;Lock enrollment record
+6 IF '$$LOCK^DGENA1(DFN)
Begin DoDot:1
+7 WRITE !,">>> Another user is editing, try later ..."
+8 DO PAUSE^VALM1
End DoDot:1
GOTO DECLINEQ
+9 ;Ask enrollment date
+10 WRITE !
+11 IF '$GET(APPDATE)
IF '$$PROMPT^DGENU(27.11,.01,DT,.APPDATE)
GOTO DECLINEQ
+12 ;Ask reason declined enrollment
+13 IF '$$PROMPT^DGENU(27.11,.05,,.REASON,1)
GOTO DECLINEQ
+14 ;If reason is 'Other', ask for remarks
+15 IF REASON=4
IF '$$PROMPT^DGENU(27.11,25,,.REMARKS,1)
GOTO DECLINEQ
+16 ;Create local enrollment array
+17 IF $$CREATE^DGENA6(DFN,APPDATE,DT,REASON,$GET(REMARKS),.DGENR)
Begin DoDot:1
+18 ;Store local enrollment as current
+19 IF $$STORECUR^DGENA1(.DGENR)
Begin DoDot:2
+20 SET DGOKF=1
+21 ;Ask preferred facility
+22 DO PREFER^DGENPT(DFN)
End DoDot:2
End DoDot:1
+23 DO UNLOCK^DGENA1(DFN)
DECLINEQ ;
+1 QUIT +$GET(DGOKF)
+2 ;
MTBULL(DFN,DGENR) ;Create/Send means test 'REQUIRED' bulletin for PATIENT ENROLLMENT
+1 ;
+2 ; Input:
+3 ; DFN - patient IEN
+4 ; DGENR - this local array represents the PATIENT ENROLLMENT and
+5 ; should be passed by reference
+6 ;
+7 ; Output: None
+8 ;
+9 NEW DGBULL,DGLINE,DGMGRP,DGNAME,DIFROM,VA,VAERR,XMTEXT,XMSUB,XMDUZ
+10 ;
+11 ; get Means Test 'Required' mail group
+12 SET DGMGRP=$PIECE($GET(^DG(43,1,"NOT")),"^",13)
+13 ;
+14 ; if mail group not defined, exit
+15 IF 'DGMGRP
GOTO MTBULLQ
+16 ;
+17 ; set up XMY array
+18 DO XMY^DGMTUTL(DGMGRP,0,1)
+19 ;
+20 ; obtain patient identifier
+21 DO PID^VADPT6
+22 ;
+23 ; patient name
+24 SET DGNAME=$PIECE($GET(^DPT(DFN,0)),"^")
+25 ;
+26 ; local array containing msg text
+27 SET XMTEXT="DGBULL("
+28 ;
+29 ; - msg subject
+30 SET XMSUB=$EXTRACT("Patient: "_DGNAME,1,30)_" ("_VA("BID")_") "_"Means Test Required"
+31 ;
+32 ; - insert lines of text into message
+33 SET DGLINE=0
+34 DO LINE("The following patient is enrolled in the VA Patient Enrollment",.DGLINE)
+35 DO LINE("System and 'REQUIRES' a means test.",.DGLINE)
+36 DO LINE("",.DGLINE)
+37 DO LINE(" Patient Name: "_DGNAME,.DGLINE)
+38 DO LINE(" Patient ID: "_VA("PID"),.DGLINE)
+39 DO LINE("",.DGLINE)
+40 DO LINE(" Enrollment Date: "_$$EXT^DGENU("DATE",DGENR("DATE")),.DGLINE)
+41 DO LINE(" Enrollment Status: "_$$EXT^DGENU("STATUS",DGENR("STATUS")),.DGLINE)
+42 DO LINE(" Entered By: "_$$EXT^DGENU("USER",DGENR("USER")),.DGLINE)
+43 DO LINE(" Date/Time Entered: "_$$EXT^DGENU("DATETIME",DGENR("DATETIME")),.DGLINE)
+44 DO ^XMD
+45 ;
MTBULLQ QUIT
+1 ;
LINE(DGTEXT,DGLINE) ;Add lines of text to mail message
+1 ;
+2 ; Input:
+3 ; DGTEXT - as line of text to be inserted into mail message
+4 ; DGLINE - as number of lines in message, passed by reference
+5 ;
+6 ; Output:
+7 ; DGBULL - as local array containing message text
+8 ;
+9 SET DGLINE=DGLINE+1
+10 SET DGBULL(DGLINE)=DGTEXT
+11 QUIT
+12 ;
MTREQ(DFN) ; --
+1 ;Determine if Means Test (required) bulletin should be sent for patient.
+2 ;
+3 ; Input:
+4 ; DFN - patient IEN
+5 ;
+6 ; Output:
+7 ; 1=Successful and 0=Failure
+8 ;
+9 NEW DGMTNODE,DGMTREQ
+10 ;
+11 ;Last means test for patient
+12 SET DGMTNODE=$$LST^DGMTU(DFN)
+13 ;
+14 ;If scheduling bulletin already sent, exit
+15 IF $PIECE($GET(^DGMT(408.31,+DGMTNODE,"BUL")),"^")=DT
GOTO MTREQQ
+16 ;
+17 ;If patient means test status is 'REQUIRED'
+18 IF $PIECE(DGMTNODE,"^",4)="R"
Begin DoDot:1
+19 ;set flag (send bulletin)
+20 SET DGMTREQ=1
End DoDot:1
+21 ;
MTREQQ QUIT +$GET(DGMTREQ)
+1 ;
VIEWDATE(FMDATE) ;
+1 ;This function changes a FM date to its external representation
+2 NEW Y
+3 SET Y=$GET(FMDATE)
+4 DO DD^%DT
+5 QUIT Y
