SDST ;BSN/GRR - PRINT ENROLLMENTS OLDER THAN X NUMBER OF DAYS ; 14 JUL 83 10:41 AM
;;5.3;Scheduling;**32,79**;Aug 13, 1993
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
RD R !,"MINIMUM DAYS OLD ENROLLMENT DATE MUST BE: ",X:DTIME I X?.E1"?" D HELP G RD
Q:"^"[X I X'?1N.N!('X) D HELP G RD
S J=X D:'$D(DT) DT^SDUTL S X1=DT,X2=J#J-J D C^%DTC S HDT=X,OLD=J
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"
S X=$$UP^XLFSTR(X) I X'="ALL" D ^DIC K DIC G:Y<0 RD1
K DIC S SDCL=$S(X="ALL":"ALL",1:+Y)
I $N(^DPT("AEB",0))'>0!($N(^DPT("AEB",0))'<HDT) W !,*7,*7,"NO ACTIVE ENROLLMENTS THAT OLD",*7,*7 Q
S VAR="OLD^HDT^SDCL^DIV",VAL=OLD_"^"_HDT_"^"_SDCL_"^"_DIV,PGM="START^SDST" D ZIS^DGUTQ G:POP END
D WAIT^DICD
START U IO K ^UTILITY($J)
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
D PRT G END
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)
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:"")
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
S ^UTILITY($J,SC,NAME,0)=SSN_"^"_NDT_"^"_TYPE_"^"_SDEC
I Q>0 F Z=1:1:Q S ^UTILITY($J,SC,NAME,Z)=N(Z)
Q
PRT K N,L,M,NAME,SSN,SDEC
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
Q
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)
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
Q
HEAD W @IOF,! S Y=DT D DT^SDM0 W ?30,"ACTIVE ENROLLMENTS OVER ",OLD," DAYS",!!,?35,K," CLINIC",!
W !,"PATIENT NAME",?22," SSN",?33,"ENROLL. DATE",?47,"ELIG CODE",?68,"OPT/AC",!
Q
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 #",!
Q
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
