| [613] | 1 | DGEN1 ;ALB/RMO - Patient Enrollment Protocols;16 JUN 1997 01:30 pm
|
|---|
| 2 | ;;5.3;Registration;**121,147,624**;08/13/93
|
|---|
| 3 | ;
|
|---|
| 4 | EP ;Entry point for DGEN ENROLL PATIENT protocol
|
|---|
| 5 | ; Input -- DFN Patient IEN
|
|---|
| 6 | ; Output -- VALMBCK R =Refresh screen
|
|---|
| 7 | ;
|
|---|
| 8 | ;send an enrollment/eligibility query
|
|---|
| 9 | I $$SEND^DGENQRY1(DFN) W !!,"Enrollment/Eligibility Query sent...",!!
|
|---|
| 10 | ;
|
|---|
| 11 | N DGENOUT
|
|---|
| 12 | S VALMBCK=""
|
|---|
| 13 | D FULL^VALM1
|
|---|
| 14 | ;
|
|---|
| 15 | ;Enroll patient
|
|---|
| 16 | I '$$ENRPAT^DGEN(DFN,.DGENOUT) D
|
|---|
| 17 | . I '$G(DGENOUT) D
|
|---|
| 18 | . . W !!,">>> Patient enrollment record was not created."
|
|---|
| 19 | . . D PAUSE^VALM1
|
|---|
| 20 | ELSE D
|
|---|
| 21 | . ;Re-build enrollment screen
|
|---|
| 22 | . D BLD^DGENL
|
|---|
| 23 | D MESSAGE^DGENL(DFN)
|
|---|
| 24 | S VALMBCK="R"
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | CE ;Entry point for DGEN CEASE ENROLLMENT protocol
|
|---|
| 28 | ; Input -- DFN Patient IEN
|
|---|
| 29 | ; Output -- VALMBCK R =Refresh screen
|
|---|
| 30 | N DGENOUT,DGENR,DGENRIEN
|
|---|
| 31 | S VALMBCK=""
|
|---|
| 32 | D FULL^VALM1
|
|---|
| 33 | ;
|
|---|
| 34 | ;Ask patient if s/he would like to cease enrollment
|
|---|
| 35 | I $$ASK^DGEN("cease enrollment",.DGENOUT) D
|
|---|
| 36 | . ;If 'Yes' cancel current enrollment
|
|---|
| 37 | . ;Find current enrollment
|
|---|
| 38 | . S DGENRIEN=$$FINDCUR^DGENA(DFN) Q:'DGENRIEN
|
|---|
| 39 | . ;Get current enrollment array
|
|---|
| 40 | . I $$GET^DGENA(DGENRIEN,.DGENR) D
|
|---|
| 41 | . . ;Cancel current enrollment
|
|---|
| 42 | . . I '$$CANCEL^DGEN(DFN,.DGENR) D
|
|---|
| 43 | . . . W !!,">>> Patient's enrollment was not ceased."
|
|---|
| 44 | . . . D PAUSE^VALM1
|
|---|
| 45 | . . ELSE D
|
|---|
| 46 | . . . ;Re-build enrollment screen
|
|---|
| 47 | . . . D BLD^DGENL
|
|---|
| 48 | D MESSAGE^DGENL(DFN)
|
|---|
| 49 | S VALMBCK="R"
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | EH ;Entry point for DGEN EXPAND HISTORY protocol
|
|---|
| 53 | ; Input -- DFN Patient IEN
|
|---|
| 54 | ; Output -- VALMBCK R =Refresh screen
|
|---|
| 55 | N DGI,DGSELY
|
|---|
| 56 | S VALMBCK=""
|
|---|
| 57 | ;
|
|---|
| 58 | ;Select entries to expand
|
|---|
| 59 | D EN^DGENLR(XQORNOD(0),"EH",.DGSELY)
|
|---|
| 60 | I $D(DGSELY("^"))!($D(DGSELY("ERR"))) G EHQ
|
|---|
| 61 | D FULL^VALM1
|
|---|
| 62 | ;
|
|---|
| 63 | ;Expand history for selected entries
|
|---|
| 64 | S DGI=0
|
|---|
| 65 | ;Loop through selection
|
|---|
| 66 | F S DGI=$O(DGSELY(DGI)) Q:'DGI D
|
|---|
| 67 | . N DGLINE,DGENRIEN
|
|---|
| 68 | . S DGLINE=+$O(^TMP("DGENIDX",$J,"EH",DGI,0)),DGENRIEN=+$G(^(DGLINE))
|
|---|
| 69 | . W !!,^TMP("DGEN",$J,DGLINE,0)
|
|---|
| 70 | . ;Load patient enrollment history screen
|
|---|
| 71 | . D EN^DGENLEH(DFN,DGENRIEN)
|
|---|
| 72 | D MESSAGE^DGENL(DFN)
|
|---|
| 73 | S VALMBCK="R"
|
|---|
| 74 | EHQ Q
|
|---|
| 75 | ;
|
|---|
| 76 | SP ;Entry point for DGEN SELECT PATIENT protocol
|
|---|
| 77 | ; Input -- None
|
|---|
| 78 | ; Output -- DFN Patient IEN
|
|---|
| 79 | ; VALMBCK R =Refresh screen
|
|---|
| 80 | N DGDFN
|
|---|
| 81 | S VALMBCK=""
|
|---|
| 82 | D FULL^VALM1
|
|---|
| 83 | ;
|
|---|
| 84 | ;Get Patient File (#2) IEN
|
|---|
| 85 | D GETPAT^DGRPTU(,,.DGDFN,)
|
|---|
| 86 | ;
|
|---|
| 87 | ;If a patient is selected
|
|---|
| 88 | I DGDFN>0 D
|
|---|
| 89 | . ;Reset DFN to selected patient
|
|---|
| 90 | . S DFN=DGDFN
|
|---|
| 91 | . ;Re-build enrollment screen for selected patient
|
|---|
| 92 | . D BLD^DGENL
|
|---|
| 93 | D MESSAGE^DGENL(DFN)
|
|---|
| 94 | S VALMBCK="R"
|
|---|
| 95 | SPQ Q
|
|---|
| 96 | ;
|
|---|
| 97 | QUERY ;entry point for DGEN SEND ENROLLMENT QUERY protocol
|
|---|
| 98 | I '$$ON^DGENQRY W "sending of enrollment queries turned off" Q
|
|---|
| 99 | N NOTIFY,DIR,ERROR
|
|---|
| 100 | S DIR("A")="Do you want to be notified when the reply is received"
|
|---|
| 101 | S DIR("B")="YES"
|
|---|
| 102 | S DIR(0)="Y"
|
|---|
| 103 | S DIR("?")="If YES, you will be mailed notification when the reply is received."
|
|---|
| 104 | D ^DIR
|
|---|
| 105 | I '$D(DIRUT) D
|
|---|
| 106 | .K DIR
|
|---|
| 107 | .I Y=1 S NOTIFY=$G(DUZ)
|
|---|
| 108 | .I $$SEND^DGENQRY1(DFN,$G(NOTIFY),,.ERROR) D
|
|---|
| 109 | ..W !!,"Enrollment/Eligibility query sent ..."
|
|---|
| 110 | .E D
|
|---|
| 111 | ..W !!,"Failure to send Query: ",ERROR
|
|---|
| 112 | .D PAUSE^VALM1
|
|---|
| 113 | D MESSAGE^DGENL(DFN)
|
|---|
| 114 | S VALMBCK="R"
|
|---|
| 115 | Q
|
|---|
| 116 | ;
|
|---|
| 117 | CHECK ;Entry point for the DGEN CHECK QUERY STATUS protocol
|
|---|
| 118 | I $$PENDING^DGENQRY(DFN) D
|
|---|
| 119 | .W !!,"Query still pending ..."
|
|---|
| 120 | .D PAUSE^VALM1
|
|---|
| 121 | .D MESSAGE^DGENL(DFN)
|
|---|
| 122 | E D
|
|---|
| 123 | .W !!,"Query is not pending ..."
|
|---|
| 124 | .D PAUSE^VALM1
|
|---|
| 125 | .D BLD^DGENL
|
|---|
| 126 | S VALMBCK="R"
|
|---|
| 127 | Q
|
|---|
| 128 | ;
|
|---|
| 129 | PEZ ;Entry point for DGENUP PRINT 1010EZ-EZR protocol (DG*5.3*624)
|
|---|
| 130 | N RPTSEL,DGTASK,MTIEN
|
|---|
| 131 | D FULL^VALM1
|
|---|
| 132 | S (RPTSEL,DGTASK,MTIEN)=""
|
|---|
| 133 | S RPTSEL=$$SEL1010^DG1010P("") ;*Select 1010EZ/R form to print
|
|---|
| 134 | D:RPTSEL'="-1"
|
|---|
| 135 | .S MTIEN=$$MTPRMPT^DG1010P(DFN,"") ;select mt to print
|
|---|
| 136 | .S DGTASK=$$PRT1010^DG1010P(RPTSEL,DFN,MTIEN) ;*Print 1010EZ/R
|
|---|
| 137 | S VALMBCK="R"
|
|---|
| 138 | Q
|
|---|
