| 1 | SDST ;BSN/GRR - PRINT ENROLLMENTS OLDER THAN X NUMBER OF DAYS ; 14 JUL 83 10:41 AM
|
|---|
| 2 | ;;5.3;Scheduling;**32,79**;Aug 13, 1993
|
|---|
| 3 | S DIV="" D DIV^SDUTL I $T S DIC("A")="ENROLLMENTS > X DAYS FOR WHICH DIVISION: " D ASK^SDDIV K DIC("A") Q:Y<0
|
|---|
| 4 | RD R !,"MINIMUM DAYS OLD ENROLLMENT DATE MUST BE: ",X:DTIME I X?.E1"?" D HELP G RD
|
|---|
| 5 | Q:"^"[X I X'?1N.N!('X) D HELP G RD
|
|---|
| 6 | S J=X D:'$D(DT) DT^SDUTL S X1=DT,X2=J#J-J D C^%DTC S HDT=X,OLD=J
|
|---|
| 7 | RD1 S DIC="^SC(",DIC(0)="EFQ",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS"")),$S(DIV="""":1,$P(^(0),""^"",15)=DIV:1,1:0)" R !,"Select Clinic: ",X:DTIME G:"^"[X END I X["?" W !,"ENTER A CLINIC NAME OR 'ALL' TO CHECK ALL CLINICS"
|
|---|
| 8 | S X=$$UP^XLFSTR(X) I X'="ALL" D ^DIC K DIC G:Y<0 RD1
|
|---|
| 9 | K DIC S SDCL=$S(X="ALL":"ALL",1:+Y)
|
|---|
| 10 | I $N(^DPT("AEB",0))'>0!($N(^DPT("AEB",0))'<HDT) W !,*7,*7,"NO ACTIVE ENROLLMENTS THAT OLD",*7,*7 Q
|
|---|
| 11 | S VAR="OLD^HDT^SDCL^DIV",VAL=OLD_"^"_HDT_"^"_SDCL_"^"_DIV,PGM="START^SDST" D ZIS^DGUTQ G:POP END
|
|---|
| 12 | D WAIT^DICD
|
|---|
| 13 | START U IO K ^UTILITY($J)
|
|---|
| 14 | S NDT=0 F I=0:0 S NDT=$N(^DPT("AEB",NDT)) Q:NDT'>0!(NDT'<HDT) F K=0:0 S K=$N(^DPT("AEB",NDT,K)) Q:K<0 F L=0:0 S L=$N(^DPT("AEB",NDT,K,L)) Q:L<0 F M=0:0 S M=$N(^DPT("AEB",NDT,K,L,M)) Q:M<0 D:$D(^DPT(K,"DE",L,0)) SET
|
|---|
| 15 | D PRT G END
|
|---|
| 16 | SET S SCN=+^DPT(K,"DE",L,0) Q:$S('$D(^SC(SCN,0)):1,SCN'=SDCL&(SDCL'="ALL"):1,SDCL="ALL":$S(DIV="":0,$P(^SC(SCN,0),"^",15)=DIV:0,1:1),1:0)
|
|---|
| 17 | S NAME=$P(^DPT(K,0),"^",1),SSN=$P(^(0),"^",9),SC=$P(^SC(SCN,0),"^",1),TYPE=$P(^DPT(K,"DE",L,1,M,0),"^",2),SDEC=$S($D(^DPT(K,.36)):+^(.36),1:"")
|
|---|
| 18 | K N S (Q,P)=0 F N=1:1 S P=$N(^DPT(K,"S",P)) Q:P<0 I $P(^(P,0),"^",1)=SCN,$P(^(0),"^",2)'["C",P>DT S Q=Q+1,N(Q)=P
|
|---|
| 19 | S ^UTILITY($J,SC,NAME,0)=SSN_"^"_NDT_"^"_TYPE_"^"_SDEC
|
|---|
| 20 | I Q>0 F Z=1:1:Q S ^UTILITY($J,SC,NAME,Z)=N(Z)
|
|---|
| 21 | Q
|
|---|
| 22 | PRT K N,L,M,NAME,SSN,SDEC
|
|---|
| 23 | S K=0 F J=1:1 S K=$N(^UTILITY($J,K)) Q:K<0 D HEAD S L=0 F LL=0:0 S L=$N(^UTILITY($J,K,L)) Q:L<0 D LINE
|
|---|
| 24 | Q
|
|---|
| 25 | LINE D:$Y+3>IOSL HEAD S A=^(L,0) W !,L,?22,$P(A,"^",1),?33 S Y=$P($P(A,"^",2),".",1) D DT^SDM0 ;NAKED REFERENCE - ^UTILITY($J,Clinic Name,0)
|
|---|
| 26 | W ?47,$S($D(^DIC(8,+$P(A,"^",4),0)):$E($P(^(0),"^",6),1,20),1:"UNKNOWN"),?70,$P(A,"^",3) S Z=0 F ZZ=1:1 S Z=$N(^UTILITY($J,K,L,Z)) Q:Z<0 W:Z=1 !,?16,"** PENDING APPOINTMENTS: " S Y=^(Z) W:Z'=1 ! W ?42," " D DT^SDM0
|
|---|
| 27 | Q
|
|---|
| 28 | HEAD W @IOF,! S Y=DT D DT^SDM0 W ?30,"ACTIVE ENROLLMENTS OVER ",OLD," DAYS",!!,?35,K," CLINIC",!
|
|---|
| 29 | W !,"PATIENT NAME",?22," SSN",?33,"ENROLL. DATE",?47,"ELIG CODE",?68,"OPT/AC",!
|
|---|
| 30 | Q
|
|---|
| 31 | HELP W !,"ENTER THE NUMBER OF DAYS PRIOR TO TODAY THAT AN ENROLLMENT DATE MUST BE",!,"TO BE PRINTED ON THIS REPORT. (I.E. '365' TO PRINT ENROLLMENT DATES PRIOR",!,"TO A YEAR AGO TODAY) - MUST BE A POSITIVE WHOLE #",!
|
|---|
| 32 | Q
|
|---|
| 33 | END W ! K A,DIC,HDT,I,J,K,L,LL,M,N,NAME,NDT,OLD,P,Q,SC,SCN,SSN,TYPE,X,X1,X2,Y,Z,ZZ,^UTILITY($J) D CLOSE^DGUTQ Q
|
|---|
