DGEN1 ;ALB/RMO - Patient Enrollment Protocols;16 JUN 1997 01:30 pm
;;5.3;Registration;**121,147,624,1015**;08/13/93;Build 21
;
EP ;Entry point for DGEN ENROLL PATIENT protocol
; Input -- DFN Patient IEN
; Output -- VALMBCK R =Refresh screen
;
;send an enrollment/eligibility query
I $$SEND^DGENQRY1(DFN) W !!,"Enrollment/Eligibility Query sent...",!!
;
N DGENOUT
S VALMBCK=""
D FULL^VALM1
;
;Enroll patient
I '$$ENRPAT^DGEN(DFN,.DGENOUT) D
. I '$G(DGENOUT) D
. . W !!,">>> Patient enrollment record was not created."
. . D PAUSE^VALM1
ELSE D
. ;Re-build enrollment screen
. D BLD^DGENL
D MESSAGE^DGENL(DFN)
S VALMBCK="R"
Q
;
CE ;Entry point for DGEN CEASE ENROLLMENT protocol
; Input -- DFN Patient IEN
; Output -- VALMBCK R =Refresh screen
N DGENOUT,DGENR,DGENRIEN
S VALMBCK=""
D FULL^VALM1
;
;Ask patient if s/he would like to cease enrollment
I $$ASK^DGEN("cease enrollment",.DGENOUT) D
. ;If 'Yes' cancel current enrollment
. ;Find current enrollment
. S DGENRIEN=$$FINDCUR^DGENA(DFN) Q:'DGENRIEN
. ;Get current enrollment array
. I $$GET^DGENA(DGENRIEN,.DGENR) D
. . ;Cancel current enrollment
. . I '$$CANCEL^DGEN(DFN,.DGENR) D
. . . W !!,">>> Patient's enrollment was not ceased."
. . . D PAUSE^VALM1
. . ELSE D
. . . ;Re-build enrollment screen
. . . D BLD^DGENL
D MESSAGE^DGENL(DFN)
S VALMBCK="R"
Q
;
EH ;Entry point for DGEN EXPAND HISTORY protocol
; Input -- DFN Patient IEN
; Output -- VALMBCK R =Refresh screen
N DGI,DGSELY
S VALMBCK=""
;
;Select entries to expand
D EN^DGENLR(XQORNOD(0),"EH",.DGSELY)
I $D(DGSELY("^"))!($D(DGSELY("ERR"))) G EHQ
D FULL^VALM1
;
;Expand history for selected entries
S DGI=0
;Loop through selection
F S DGI=$O(DGSELY(DGI)) Q:'DGI D
. N DGLINE,DGENRIEN
. S DGLINE=+$O(^TMP("DGENIDX",$J,"EH",DGI,0)),DGENRIEN=+$G(^(DGLINE))
. W !!,^TMP("DGEN",$J,DGLINE,0)
. ;Load patient enrollment history screen
. D EN^DGENLEH(DFN,DGENRIEN)
D MESSAGE^DGENL(DFN)
S VALMBCK="R"
EHQ Q
;
SP ;Entry point for DGEN SELECT PATIENT protocol
; Input -- None
; Output -- DFN Patient IEN
; VALMBCK R =Refresh screen
N DGDFN
S VALMBCK=""
D FULL^VALM1
;
;Get Patient File (#2) IEN
D GETPAT^DGRPTU(,,.DGDFN,)
;
;If a patient is selected
I DGDFN>0 D
. ;Reset DFN to selected patient
. S DFN=DGDFN
. ;Re-build enrollment screen for selected patient
. D BLD^DGENL
D MESSAGE^DGENL(DFN)
S VALMBCK="R"
SPQ Q
;
QUERY ;entry point for DGEN SEND ENROLLMENT QUERY protocol
I '$$ON^DGENQRY W "sending of enrollment queries turned off" Q
N NOTIFY,DIR,ERROR
S DIR("A")="Do you want to be notified when the reply is received"
S DIR("B")="YES"
S DIR(0)="Y"
S DIR("?")="If YES, you will be mailed notification when the reply is received."
D ^DIR
I '$D(DIRUT) D
.K DIR
.I Y=1 S NOTIFY=$G(DUZ)
.I $$SEND^DGENQRY1(DFN,$G(NOTIFY),,.ERROR) D
..W !!,"Enrollment/Eligibility query sent ..."
.E D
..W !!,"Failure to send Query: ",ERROR
.D PAUSE^VALM1
D MESSAGE^DGENL(DFN)
S VALMBCK="R"
Q
;
CHECK ;Entry point for the DGEN CHECK QUERY STATUS protocol
I $$PENDING^DGENQRY(DFN) D
.W !!,"Query still pending ..."
.D PAUSE^VALM1
.D MESSAGE^DGENL(DFN)
E D
.W !!,"Query is not pending ..."
.D PAUSE^VALM1
.D BLD^DGENL
S VALMBCK="R"
Q
;
PEZ ;Entry point for DGENUP PRINT 1010EZ-EZR protocol (DG*5.3*624)
N RPTSEL,DGTASK,MTIEN
D FULL^VALM1
S (RPTSEL,DGTASK,MTIEN)=""
S RPTSEL=$$SEL1010^DG1010P("") ;*Select 1010EZ/R form to print
D:RPTSEL'="-1"
.S MTIEN=$$MTPRMPT^DG1010P(DFN,"") ;select mt to print
.S DGTASK=$$PRT1010^DG1010P(RPTSEL,DFN,MTIEN) ;*Print 1010EZ/R
S VALMBCK="R"
Q
DGEN1 ;ALB/RMO - Patient Enrollment Protocols;16 JUN 1997 01:30 pm
+1 ;;5.3;Registration;**121,147,624,1015**;08/13/93;Build 21
+2 ;
EP ;Entry point for DGEN ENROLL PATIENT protocol
+1 ; Input -- DFN Patient IEN
+2 ; Output -- VALMBCK R =Refresh screen
+3 ;
+4 ;send an enrollment/eligibility query
+5 IF $$SEND^DGENQRY1(DFN)
WRITE !!,"Enrollment/Eligibility Query sent...",!!
+6 ;
+7 NEW DGENOUT
+8 SET VALMBCK=""
+9 DO FULL^VALM1
+10 ;
+11 ;Enroll patient
+12 IF '$$ENRPAT^DGEN(DFN,.DGENOUT)
Begin DoDot:1
+13 IF '$GET(DGENOUT)
Begin DoDot:2
+14 WRITE !!,">>> Patient enrollment record was not created."
+15 DO PAUSE^VALM1
End DoDot:2
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 ;Re-build enrollment screen
+18 DO BLD^DGENL
End DoDot:1
+19 DO MESSAGE^DGENL(DFN)
+20 SET VALMBCK="R"
+21 QUIT
+22 ;
CE ;Entry point for DGEN CEASE ENROLLMENT protocol
+1 ; Input -- DFN Patient IEN
+2 ; Output -- VALMBCK R =Refresh screen
+3 NEW DGENOUT,DGENR,DGENRIEN
+4 SET VALMBCK=""
+5 DO FULL^VALM1
+6 ;
+7 ;Ask patient if s/he would like to cease enrollment
+8 IF $$ASK^DGEN("cease enrollment",.DGENOUT)
Begin DoDot:1
+9 ;If 'Yes' cancel current enrollment
+10 ;Find current enrollment
+11 SET DGENRIEN=$$FINDCUR^DGENA(DFN)
IF 'DGENRIEN
QUIT
+12 ;Get current enrollment array
+13 IF $$GET^DGENA(DGENRIEN,.DGENR)
Begin DoDot:2
+14 ;Cancel current enrollment
+15 IF '$$CANCEL^DGEN(DFN,.DGENR)
Begin DoDot:3
+16 WRITE !!,">>> Patient's enrollment was not ceased."
+17 DO PAUSE^VALM1
End DoDot:3
+18 IF '$TEST
Begin DoDot:3
+19 ;Re-build enrollment screen
+20 DO BLD^DGENL
End DoDot:3
End DoDot:2
End DoDot:1
+21 DO MESSAGE^DGENL(DFN)
+22 SET VALMBCK="R"
+23 QUIT
+24 ;
EH ;Entry point for DGEN EXPAND HISTORY protocol
+1 ; Input -- DFN Patient IEN
+2 ; Output -- VALMBCK R =Refresh screen
+3 NEW DGI,DGSELY
+4 SET VALMBCK=""
+5 ;
+6 ;Select entries to expand
+7 DO EN^DGENLR(XQORNOD(0),"EH",.DGSELY)
+8 IF $DATA(DGSELY("^"))!($DATA(DGSELY("ERR")))
GOTO EHQ
+9 DO FULL^VALM1
+10 ;
+11 ;Expand history for selected entries
+12 SET DGI=0
+13 ;Loop through selection
+14 FOR
SET DGI=$ORDER(DGSELY(DGI))
IF 'DGI
QUIT
Begin DoDot:1
+15 NEW DGLINE,DGENRIEN
+16 SET DGLINE=+$ORDER(^TMP("DGENIDX",$JOB,"EH",DGI,0))
SET DGENRIEN=+$GET(^(DGLINE))
+17 WRITE !!,^TMP("DGEN",$JOB,DGLINE,0)
+18 ;Load patient enrollment history screen
+19 DO EN^DGENLEH(DFN,DGENRIEN)
End DoDot:1
+20 DO MESSAGE^DGENL(DFN)
+21 SET VALMBCK="R"
EHQ QUIT
+1 ;
SP ;Entry point for DGEN SELECT PATIENT protocol
+1 ; Input -- None
+2 ; Output -- DFN Patient IEN
+3 ; VALMBCK R =Refresh screen
+4 NEW DGDFN
+5 SET VALMBCK=""
+6 DO FULL^VALM1
+7 ;
+8 ;Get Patient File (#2) IEN
+9 DO GETPAT^DGRPTU(,,.DGDFN,)
+10 ;
+11 ;If a patient is selected
+12 IF DGDFN>0
Begin DoDot:1
+13 ;Reset DFN to selected patient
+14 SET DFN=DGDFN
+15 ;Re-build enrollment screen for selected patient
+16 DO BLD^DGENL
End DoDot:1
+17 DO MESSAGE^DGENL(DFN)
+18 SET VALMBCK="R"
SPQ QUIT
+1 ;
QUERY ;entry point for DGEN SEND ENROLLMENT QUERY protocol
+1 IF '$$ON^DGENQRY
WRITE "sending of enrollment queries turned off"
QUIT
+2 NEW NOTIFY,DIR,ERROR
+3 SET DIR("A")="Do you want to be notified when the reply is received"
+4 SET DIR("B")="YES"
+5 SET DIR(0)="Y"
+6 SET DIR("?")="If YES, you will be mailed notification when the reply is received."
+7 DO ^DIR
+8 IF '$DATA(DIRUT)
Begin DoDot:1
+9 KILL DIR
+10 IF Y=1
SET NOTIFY=$GET(DUZ)
+11 IF $$SEND^DGENQRY1(DFN,$GET(NOTIFY),,.ERROR)
Begin DoDot:2
+12 WRITE !!,"Enrollment/Eligibility query sent ..."
End DoDot:2
+13 IF '$TEST
Begin DoDot:2
+14 WRITE !!,"Failure to send Query: ",ERROR
End DoDot:2
+15 DO PAUSE^VALM1
End DoDot:1
+16 DO MESSAGE^DGENL(DFN)
+17 SET VALMBCK="R"
+18 QUIT
+19 ;
CHECK ;Entry point for the DGEN CHECK QUERY STATUS protocol
+1 IF $$PENDING^DGENQRY(DFN)
Begin DoDot:1
+2 WRITE !!,"Query still pending ..."
+3 DO PAUSE^VALM1
+4 DO MESSAGE^DGENL(DFN)
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 WRITE !!,"Query is not pending ..."
+7 DO PAUSE^VALM1
+8 DO BLD^DGENL
End DoDot:1
+9 SET VALMBCK="R"
+10 QUIT
+11 ;
PEZ ;Entry point for DGENUP PRINT 1010EZ-EZR protocol (DG*5.3*624)
+1 NEW RPTSEL,DGTASK,MTIEN
+2 DO FULL^VALM1
+3 SET (RPTSEL,DGTASK,MTIEN)=""
+4 ;*Select 1010EZ/R form to print
SET RPTSEL=$$SEL1010^DG1010P("")
+5 IF RPTSEL'="-1"
Begin DoDot:1
+6 ;select mt to print
SET MTIEN=$$MTPRMPT^DG1010P(DFN,"")
+7 ;*Print 1010EZ/R
SET DGTASK=$$PRT1010^DG1010P(RPTSEL,DFN,MTIEN)
End DoDot:1
+8 SET VALMBCK="R"
+9 QUIT
