| 1 | YSCEN7 ;ALB/ASF-MH CENSUS TEAM HX ;4/3/90 11:13 ;
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
|
|---|
| 3 | CLN ;
|
|---|
| 4 | K IOP,YSTY,YSIDT,N4,YSAGE,B1,YSDOB,YSNM,YSSEX,YSSSN,YSTM,YSUS,YSUSER,YSBID D KVAR^VADPT Q
|
|---|
| 5 | FINO ;
|
|---|
| 6 | D WAIT^YSCEN1,KILL^%ZTLOAD
|
|---|
| 7 | FIN ;
|
|---|
| 8 | D CLN K C,DIYS,ZTSK,W2,X,Y,YSFS,G1,P1,T,G2,T3,T4,T5,T8,W1,Y,Y1,Y7,YSDFN,I,F,Q3,X1,YS,^UTILITY($J),YSPCK,IOP W !! D ^%ZISC Q
|
|---|
| 9 | ;
|
|---|
| 10 | HIST ; Called from MENU option YSCENTAH
|
|---|
| 11 | ;
|
|---|
| 12 | K YS,Y7,T3,T4,T5,W1 S IOP=0 D ^%ZIS Q:POP K IOP W @IOF,!!,"TEAM ADMISSION RECORD",!!
|
|---|
| 13 | HISTQ ;
|
|---|
| 14 | R !,"Do you wish to see all wards? N// ",X:DTIME S YSTOUT='$T,YSUOUT=X["^" G:YSTOUT FIN
|
|---|
| 15 | S YSR1="X",YSR2="N",YSR3="YN",YSR4="Answer No to restrict listing to one ward" D ^YSCEN14 G FIN:X=-1,HISTQ:X="?" D X3:X="Y",X1:X="N"
|
|---|
| 16 | HS ;
|
|---|
| 17 | G:'$D(YS) FIN K IOP S %ZIS="Q" D ^%ZIS G:POP FIN I $D(IO("Q")) K IO("Q") S ZTRTN="ENQ^YSCEN7",ZTDESC="YS IP 7",(ZTSAVE("W1"),ZTSAVE("W2"),ZTSAVE("YS("))="" D ^%ZTLOAD W !,$S($D(ZTSK):"QUEUED",1:"Not queued"),$C(7) G FIN
|
|---|
| 18 | ENQ ;
|
|---|
| 19 | U IO W @IOF,!!,"TEAM ADMISSION RECORD" S X="NOW",%DT="T" D ^%DT,ENDD^YSUTL W ?60,Y,! S X="T-14",%DT="T" D ^%DT S T8=9999999-Y
|
|---|
| 20 | W !,"This is a listing of recent team assignments and re-assignments by time",!,"for the past 14 days or less. It does not indicate ward admission dates.",!
|
|---|
| 21 | W !,"The following wards are included: " S (X1,YSFIRST)=0 F S YSFIRST=YSFIRST+1,X1=$O(YS(X1)) Q:'X1 S W2=$P(^YSG("CEN",X1,0),U,2) S X=$S(YSFIRST=1:"W W2",$X+$L(W2)+2>IOM:"W "","",!,W2",1:"W "", "",W2") X X
|
|---|
| 22 | S YSPCK=0 W !! S (T3,Q3)=0 F S T3=$O(^YSG("INP","AST",T3)) Q:'T3!(T3>T8)!Q3 D HS1
|
|---|
| 23 | S T8=T8+1 F S T8=$O(^YSG("INP","AST",T8)) Q:'T8 K ^YSG("INP","AST",T8)
|
|---|
| 24 | W:YSPCK'=1 !!?2,"No team assignments or re-assignments within the last 14 days were found.",!,$C(7) D FINO Q
|
|---|
| 25 | HS1 ;
|
|---|
| 26 | S T4=0 F S T4=$O(^YSG("INP","AST",T3,T4)) Q:'T4 D HS2:$D(YS(T4))
|
|---|
| 27 | Q
|
|---|
| 28 | HS2 ;
|
|---|
| 29 | S T5=0 F S T5=$O(^YSG("INP","AST",T3,T4,T5)) Q:'T5 D HS3
|
|---|
| 30 | Q
|
|---|
| 31 | HS3 ;
|
|---|
| 32 | S DA=0 F S DA=$O(^YSG("INP","AST",T3,T4,T5,DA)) Q:'DA D HS4
|
|---|
| 33 | Q
|
|---|
| 34 | HS4 ;
|
|---|
| 35 | I $D(^YSG("INP",DA)) S YSDFN=$P(^YSG("INP",DA,0),U,2) D HSP Q
|
|---|
| 36 | I '$D(^YSG("INP",DA)) K ^YSG("INP","AST",T3,T4,T5,DA)
|
|---|
| 37 | Q
|
|---|
| 38 | HSP ;
|
|---|
| 39 | Q:Q3 S:'$D(Y7) Y7=9999999 S X=9999999-T3,%DT="T" D ^%DT S Y1=Y,X=Y#1 X:X ^DD("FUNC",2,1) W !,$$FMTE^XLFDT(Y,"5ZD")," ",$G(X) W ?22,$P(^DPT(YSDFN,0),U) S Y7=Y1,YSPCK=1
|
|---|
| 40 | W ?47,$P(^DIC(42,T4,0),U)," ",$P(^YSG("SUB",T5,0),U) D:$Y+4>IOSL WW Q
|
|---|
| 41 | X1 ;
|
|---|
| 42 | W !!,"Enter each ward to be displayed",!,"and hit return when all desired wards are entered",!
|
|---|
| 43 | X2 ;
|
|---|
| 44 | D UN^YSCEN2 K:X="^" YS Q:Y<1 S YS(+Y)="" G X2
|
|---|
| 45 | X3 ;
|
|---|
| 46 | K YS S F=0 F S F=$O(^YSG("CEN","AFS",F)) Q:'F S W1=$O(^YSG("CEN","AFS",F,0)) Q:'W1 S YS(W1)=""
|
|---|
| 47 | Q
|
|---|
| 48 | WW ;
|
|---|
| 49 | D WAIT^YSCEN1 Q:Q3 W @IOF,"TEAM ADMISSION RECORD cont",! S Y7=9999999 Q
|
|---|
| 50 | END ;
|
|---|
| 51 | K %DT,I,X,Y,Y1 Q
|
|---|
