| [613] | 1 | SDPPENR1 ;ALB/CAW - Patient Profile - Enrollments ; 5/13/92
|
|---|
| 2 | ;;5.3;Scheduling;**6,140**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | EN1 ; Enrollments
|
|---|
| 6 | N SD,SD1,SDCL,SDEN,SDFLN,SDOPT,SDSTAT,SDSTART,SDSTOP
|
|---|
| 7 | S SD=0,SDFST=9,SDSEC=53,SDFLN=7,SDLEN=28,$P(SDASH,"-",IOM+1)="",SDSTART=$S($D(SDBEG):SDBEG,1:SDBD),SDSTOP=$S($D(SDEND):SDEND,1:SDED)
|
|---|
| 8 | F S SD=$O(^DPT(DFN,"DE",SD)) Q:'SD S SD1=0,SDCL=$G(^(SD,0)) F S SD1=$O(^DPT(DFN,"DE",SD,1,SD1)) Q:'SD1 S SDEN=$G(^(SD1,0)) D CHECKS
|
|---|
| 9 | S SD=-9999999.99 F S SD=$O(^TMP("SDENR",$J,SD)) Q:'SD S SD1=0 F S SD1=$O(^TMP("SDENR",$J,SD,SD1)) Q:'SD1 S SDCL=^(SD1,0),SDEN=^(1),SDDT=$E(SD,2,999) D INFO
|
|---|
| 10 | K ^TMP("SDENR",$J) Q
|
|---|
| 11 | ;
|
|---|
| 12 | CHECKS ; Checks
|
|---|
| 13 | ; Check for specified clinic
|
|---|
| 14 | I $D(SDY),SDY'=+SDCL Q
|
|---|
| 15 | ; Add all active enrollments if printing regardless of date range
|
|---|
| 16 | I SDPRINT,$P(SDEN,U,3)="" D CHKSET
|
|---|
| 17 | ; Check for active enrollments
|
|---|
| 18 | I SDACT,$P(SDEN,U,3)'="" Q
|
|---|
| 19 | ; Check for date range
|
|---|
| 20 | I +SDEN>SDSTOP!(+SDEN<SDSTART) Q
|
|---|
| 21 | ; Otherwise file info
|
|---|
| 22 | CHKSET S ^TMP("SDENR",$J,-$P(SDEN,U),SD1,0)=SDCL,^(1)=SDEN
|
|---|
| 23 | Q
|
|---|
| 24 | INFO ;
|
|---|
| 25 | ;
|
|---|
| 26 | CLINIC ; Enrollment Clinic and Enrollment Date
|
|---|
| 27 | S X="",X=$$SETSTR^VALM1("Clinic:",X,1,SDFLN)
|
|---|
| 28 | S X=$$SETSTR^VALM1($P($G(^SC(+SDCL,0)),U),X,SDFST,SDLEN)
|
|---|
| 29 | S X=$$SETSTR^VALM1("Enroll. Date:",X,39,13)
|
|---|
| 30 | S X=$$SETSTR^VALM1($TR($$FMTE^XLFDT(+SDEN,"5DF")," ","0"),X,SDSEC,SDLEN)
|
|---|
| 31 | D SET(X)
|
|---|
| 32 | STATUS ; Current Status and Enrollement Discharge Date
|
|---|
| 33 | S X="",X=$$SETSTR^VALM1("Status:",X,1,SDFLN)
|
|---|
| 34 | S SDSTAT=$S($P(SDEN,U,3)="":"ACTIVE",1:"INACTIVE")
|
|---|
| 35 | S X=$$SETSTR^VALM1(SDSTAT,X,SDFST,SDLEN)
|
|---|
| 36 | I $P(SDEN,U,3)'="" D
|
|---|
| 37 | .S X=$$SETSTR^VALM1("Disch. Date:",X,40,12)
|
|---|
| 38 | .S X=$$SETSTR^VALM1($$FDATE^VALM1($P(SDEN,U,3)),X,SDSEC,SDLEN)
|
|---|
| 39 | D SET(X)
|
|---|
| 40 | OPT ; OPT or AC and Review Date
|
|---|
| 41 | S X="",X=$$SETSTR^VALM1("OPT/AC:",X,1,SDFLN)
|
|---|
| 42 | S SDOPT=$S($P(SDEN,U,2)="O":"OPT",$P(SDEN,U,2)="A":"AC",1:"UNKNOWN")
|
|---|
| 43 | S X=$$SETSTR^VALM1(SDOPT,X,SDFST,SDLEN)
|
|---|
| 44 | I $P(SDEN,U,5)'="" D
|
|---|
| 45 | .S X=$$SETSTR^VALM1("Review Date:",X,40,12)
|
|---|
| 46 | .S X=$$SETSTR^VALM1($$FDATE^VALM1($P(SDEN,U,5)),X,SDSEC,SDLEN)
|
|---|
| 47 | D SET(X)
|
|---|
| 48 | REASON ; Reason for Discharge
|
|---|
| 49 | I $P(SDEN,U,4)'="" D
|
|---|
| 50 | .S X="",X=$$SETSTR^VALM1("Reason:",X,1,SDFLN)
|
|---|
| 51 | .S X=$$SETSTR^VALM1($P(SDEN,U,4),X,SDFST,70)
|
|---|
| 52 | .D SET(X)
|
|---|
| 53 | D SET("")
|
|---|
| 54 | Q
|
|---|
| 55 | SET(X) ; Set in ^TMP global for display
|
|---|
| 56 | ;
|
|---|
| 57 | S SDLN=SDLN+1,^TMP("SDPPALL",$J,SDLN,0)=X
|
|---|
| 58 | Q
|
|---|
