- DGEN1 ;ALB/RMO,RN - Patient Enrollment Protocols;16 JUN 1997 01:30 pm ; 17 Dec 2014 4:04 PM
- ;;5.3;Registration;**121,147,624,1027**;08/13/93;Build 70
- ;
- EP ;Entry point for DGEN ENROLL PATIENT protocol
- ; Disabled the DGEN PATIENT ENROLLEMNT protocol(EP) with DG*5.3*1027
- ; Input -- DFN Patient IEN
- ; Output -- VALMBCK R =Refresh screen
- ;
- ;send an enrollment/eligibility query
- W !!,">>> Use the Enrollment System to complete the enrollment process."
- D PAUSE^VALM1
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGEN1 3649 printed Jan 18, 2025@03:42:53 Page 2
- DGEN1 ;ALB/RMO,RN - Patient Enrollment Protocols;16 JUN 1997 01:30 pm ; 17 Dec 2014 4:04 PM
- +1 ;;5.3;Registration;**121,147,624,1027**;08/13/93;Build 70
- +2 ;
- EP ;Entry point for DGEN ENROLL PATIENT protocol
- +1 ; Disabled the DGEN PATIENT ENROLLEMNT protocol(EP) with DG*5.3*1027
- +2 ; Input -- DFN Patient IEN
- +3 ; Output -- VALMBCK R =Refresh screen
- +4 ;
- +5 ;send an enrollment/eligibility query
- +6 WRITE !!,">>> Use the Enrollment System to complete the enrollment process."
- +7 DO PAUSE^VALM1
- +8 DO BLD^DGENL
- +9 DO MESSAGE^DGENL(DFN)
- +10 SET VALMBCK="R"
- +11 QUIT
- +12 ;
- 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