Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGEN1

DGEN1.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. EP ;Entry point for DGEN ENROLL PATIENT protocol
  1. ; Disabled the DGEN PATIENT ENROLLEMNT protocol(EP) with DG*5.3*1027
  1. ; Input -- DFN Patient IEN
  1. ; Output -- VALMBCK R =Refresh screen
  1. ;
  1. ;send an enrollment/eligibility query
  1. W !!,">>> Use the Enrollment System to complete the enrollment process."
  1. D PAUSE^VALM1
  1. D BLD^DGENL
  1. D MESSAGE^DGENL(DFN)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. CE ;Entry point for DGEN CEASE ENROLLMENT protocol
  1. ; Input -- DFN Patient IEN
  1. ; Output -- VALMBCK R =Refresh screen
  1. N DGENOUT,DGENR,DGENRIEN
  1. S VALMBCK=""
  1. D FULL^VALM1
  1. ;
  1. ;Ask patient if s/he would like to cease enrollment
  1. I $$ASK^DGEN("cease enrollment",.DGENOUT) D
  1. . ;If 'Yes' cancel current enrollment
  1. . ;Find current enrollment
  1. . S DGENRIEN=$$FINDCUR^DGENA(DFN) Q:'DGENRIEN
  1. . ;Get current enrollment array
  1. . I $$GET^DGENA(DGENRIEN,.DGENR) D
  1. . . ;Cancel current enrollment
  1. . . I '$$CANCEL^DGEN(DFN,.DGENR) D
  1. . . . W !!,">>> Patient's enrollment was not ceased."
  1. . . . D PAUSE^VALM1
  1. . . ELSE D
  1. . . . ;Re-build enrollment screen
  1. . . . D BLD^DGENL
  1. D MESSAGE^DGENL(DFN)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. EH ;Entry point for DGEN EXPAND HISTORY protocol
  1. ; Input -- DFN Patient IEN
  1. ; Output -- VALMBCK R =Refresh screen
  1. N DGI,DGSELY
  1. S VALMBCK=""
  1. ;
  1. ;Select entries to expand
  1. D EN^DGENLR(XQORNOD(0),"EH",.DGSELY)
  1. I $D(DGSELY("^"))!($D(DGSELY("ERR"))) G EHQ
  1. D FULL^VALM1
  1. ;
  1. ;Expand history for selected entries
  1. S DGI=0
  1. ;Loop through selection
  1. F S DGI=$O(DGSELY(DGI)) Q:'DGI D
  1. . N DGLINE,DGENRIEN
  1. . S DGLINE=+$O(^TMP("DGENIDX",$J,"EH",DGI,0)),DGENRIEN=+$G(^(DGLINE))
  1. . W !!,^TMP("DGEN",$J,DGLINE,0)
  1. . ;Load patient enrollment history screen
  1. . D EN^DGENLEH(DFN,DGENRIEN)
  1. D MESSAGE^DGENL(DFN)
  1. S VALMBCK="R"
  1. EHQ Q
  1. ;
  1. SP ;Entry point for DGEN SELECT PATIENT protocol
  1. ; Input -- None
  1. ; Output -- DFN Patient IEN
  1. ; VALMBCK R =Refresh screen
  1. N DGDFN
  1. S VALMBCK=""
  1. D FULL^VALM1
  1. ;
  1. ;Get Patient File (#2) IEN
  1. D GETPAT^DGRPTU(,,.DGDFN,)
  1. ;
  1. ;If a patient is selected
  1. I DGDFN>0 D
  1. . ;Reset DFN to selected patient
  1. . S DFN=DGDFN
  1. . ;Re-build enrollment screen for selected patient
  1. . D BLD^DGENL
  1. D MESSAGE^DGENL(DFN)
  1. S VALMBCK="R"
  1. SPQ Q
  1. ;
  1. QUERY ;entry point for DGEN SEND ENROLLMENT QUERY protocol
  1. I '$$ON^DGENQRY W "sending of enrollment queries turned off" Q
  1. N NOTIFY,DIR,ERROR
  1. S DIR("A")="Do you want to be notified when the reply is received"
  1. S DIR("B")="YES"
  1. S DIR(0)="Y"
  1. S DIR("?")="If YES, you will be mailed notification when the reply is received."
  1. D ^DIR
  1. I '$D(DIRUT) D
  1. .K DIR
  1. .I Y=1 S NOTIFY=$G(DUZ)
  1. .I $$SEND^DGENQRY1(DFN,$G(NOTIFY),,.ERROR) D
  1. ..W !!,"Enrollment/Eligibility query sent ..."
  1. .E D
  1. ..W !!,"Failure to send Query: ",ERROR
  1. .D PAUSE^VALM1
  1. D MESSAGE^DGENL(DFN)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. CHECK ;Entry point for the DGEN CHECK QUERY STATUS protocol
  1. I $$PENDING^DGENQRY(DFN) D
  1. .W !!,"Query still pending ..."
  1. .D PAUSE^VALM1
  1. .D MESSAGE^DGENL(DFN)
  1. E D
  1. .W !!,"Query is not pending ..."
  1. .D PAUSE^VALM1
  1. .D BLD^DGENL
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. PEZ ;Entry point for DGENUP PRINT 1010EZ-EZR protocol (DG*5.3*624)
  1. N RPTSEL,DGTASK,MTIEN
  1. D FULL^VALM1
  1. S (RPTSEL,DGTASK,MTIEN)=""
  1. S RPTSEL=$$SEL1010^DG1010P("") ;*Select 1010EZ/R form to print
  1. D:RPTSEL'="-1"
  1. .S MTIEN=$$MTPRMPT^DG1010P(DFN,"") ;select mt to print
  1. .S DGTASK=$$PRT1010^DG1010P(RPTSEL,DFN,MTIEN) ;*Print 1010EZ/R
  1. S VALMBCK="R"
  1. Q