| 1 | YSCEN2 ;ALB/ASF-MH CENSUS PATIENT LIST ;4/16/92 09:53 ;08/13/93 15:48
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
|
|---|
| 3 | UN ;
|
|---|
| 4 | ; called routines YSCEN1, YSCEN13, YSCEN21, YSCEN22, YSCEN24, YSCEN3,
|
|---|
| 5 | ; YSCEN51, YSCEN52, YSCEN61, YSCEN7, YSCEN8, YSCEN81
|
|---|
| 6 | N DIC
|
|---|
| 7 | S DIC="^YSG(""CEN"",",DIC(0)="AEQZM",DIC("A")="Select Inpatient Ward: ",DIC("S")="I '$P(^(0),U,13)" D ^DIC K DIC("S") Q:Y<1 S W1=+Y,W2=Y(0,0) K Y(0),Y(0,0)
|
|---|
| 8 | Q
|
|---|
| 9 | L1 ; called by ENQ and routines YSCEN1, YSCEN13, YSCEN22, YSCEN31
|
|---|
| 10 | ; YSCEN34 ,YSCEN39, YSCEN4, YSCEN5, YSCEN55, YSCEN6, YSCEN61, YSCEN8
|
|---|
| 11 | S (Q3,T6,C2)=0,W2=$P(^DIC(42,W1,0),U) S:'$D(P1) P1=1
|
|---|
| 12 | F S C2=$O(^YSG("SUB","AOR",W1,C2)) Q:'C2 S T6=$O(^(C2,0)) Q:'T6 K ^UTILITY($J) I '$P($G(^YSG("SUB",T6,1)),U,5) D L2 D:P1 L3,WAIT^YSCEN1:'$D(YSOPT1)!($D(YSCENN)) Q:Q3
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | L2 ; called by L1 and routines YSCEN1, YSCEN21, YSCEN23, YSCEN24, YSCEN3
|
|---|
| 16 | ; YSCEN31, YSCEN34, YSCEN35, YSCEN39, YSCEN4, YSCEN8
|
|---|
| 17 | U IO I $G(T6)="S" G S1^YSCEN26
|
|---|
| 18 | S (YSTM,YSDFN,YSDA)=0
|
|---|
| 19 | F S YSDA=$O(^YSG("INP","AWC",W1,+T6,YSDA)) Q:'YSDA S YSDFN=$P(^YSG("INP",YSDA,0),U,2),X1=+$G(^DPT("CN",W2,YSDFN)) I X1 S ^UTILITY($J,$P(^DPT(YSDFN,0),U),YSDFN)=YSDA,YSTM=YSTM+1
|
|---|
| 20 | D:$D(YSOPT2) @YSOPT2
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | L3 ; Called by routines YSCEN24, YSCEN26, YSCEN3
|
|---|
| 24 | ;
|
|---|
| 25 | D:'$D(YSOPT1)!$D(YSOPT1L) H1 G:'$D(^UTILITY($J)) L8 S N1="A" F S N1=$O(^UTILITY($J,N1)) Q:N1=""!Q3 D L6
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | L6 ;
|
|---|
| 29 | S YSDFN=0 F S YSDFN=$O(^UTILITY($J,N1,YSDFN)) Q:'YSDFN D H1:$D(YSOPT1)&(($Y<3)!($Y+5>IOSL)),L7,WAIT^YSCEN1:$D(YSOPT1)&($Y+5>IOSL) Q:Q3
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | L7 ;
|
|---|
| 33 | I $Y>(IOSL-5) D WAIT^YSCEN1 Q:Q3 D H1
|
|---|
| 34 | D ENPT^YSUTL S DA=^UTILITY($J,N1,YSDFN),G=^YSG("INP",DA,0) W !,YSNM,?30,YSBID,?35,$J(YSAGE,3)
|
|---|
| 35 | S X=$P(G,U,3),X(1)=$$FMTE^XLFDT(X,"5ZD") W ?39,X(1)
|
|---|
| 36 | I $D(^YSG("INP",DA,1)) S G3=^(1) W $P(G3,U),$P(G3,U,2),$P(G3,U,3)
|
|---|
| 37 | S X1=DT,X2=X D ^%DTC W ?50,$J(X,4) S X=$P(G,U,5) W ?56 D:X?1N.N D3 W:$D(^DPT(YSDFN,.101)) ?70,^(.101)
|
|---|
| 38 | I $D(YSOPT1) D @YSOPT1
|
|---|
| 39 | K G,G3 Q
|
|---|
| 40 | L8 ;
|
|---|
| 41 | D:$Y<3 H1 W !!,"No patients" Q
|
|---|
| 42 | ;
|
|---|
| 43 | H1 ; Called form routines YSCEN23, YSCEN31
|
|---|
| 44 | ;
|
|---|
| 45 | S YSTLE=$S($D(YSOPT1L):YSOPT1L,1:"PATIENT LIST") W:$Y>1 @IOF W "WARD: ",W2,?$X+(IOM-$X-25-($L(YSTLE))/2),YSTLE D TIME
|
|---|
| 46 | I $G(YSOPT9L)]""&($G(YSWHO)>0) W !?3,YSOPT9L,$P(^VA(200,+YSWHO,0),U)
|
|---|
| 47 | S G2=^YSG("SUB",T6,0)
|
|---|
| 48 | W !,"TEAM: ",$P(G2,U),?20," Beds: ",$P(^YSG("SUB",T6,1),U,3),?35," Patients: ",YSTM S X=$P(G2,U,9) I YSTLE="PATIENT LIST" W !,"Team Leader: " D D3 W ?20," Physician: " S X=$P(G2,U,2) D D3 W ?50," Psychologist: " S X=$P(G2,U,3) D D3
|
|---|
| 49 | H12 ;
|
|---|
| 50 | W !,"NAME",?30,"SSN",?35,"AGE",?39,"ENTERED",?50,"DAYS",?56,$S(T6?1N.N:$P(^YSG("SUB",T6,0),U,10),1:""),?70,"BED",!
|
|---|
| 51 | S C1="",$P(C1,"-",81)="" W C1,!
|
|---|
| 52 | Q
|
|---|
| 53 | TIME ; Called by routines YSCEN24, YSCEN35, YSCEN39, YSCEN81
|
|---|
| 54 | ;
|
|---|
| 55 | S:$D(YSTM) YSTMX=YSTM K Y D ENDTM^YSUTL W ?57,YSDT(1)," ",YSTM S:$D(YSTMX) YSTM=YSTMX
|
|---|
| 56 | Q
|
|---|
| 57 | D3 ; Called by routines YSCEN21, YSCEN22, YSCEN23, YSCEN35, YSCEN54
|
|---|
| 58 | ; YSCEN61, YSCEN8
|
|---|
| 59 | ;
|
|---|
| 60 | Q:X'?1N.N S X=$P(^VA(200,X,0),U),X(2)=$E($P(X,",",2),1,2) S X(2)=$S(X(2)?1P.E:$E(X(2),2),1:$E(X(2))) W " ",$P(X,","),",",X(2)
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | EN ; Called from MENU option YSCENSL
|
|---|
| 64 | ; Called from MENU option YSCENPATL
|
|---|
| 65 | ;
|
|---|
| 66 | R !!,"Print all wards? N// ",YSOP:DTIME S YSTOUT='$T,YSUOUT=YSOP["^" G:YSTOUT END
|
|---|
| 67 | S YSR1="YSOP",YSR2="N",YSR3="YN" D ^YSCEN14 G EN:YSOP="?",END:YSOP=-1,ENALL:YSOP="Y"
|
|---|
| 68 | EN1 ;
|
|---|
| 69 | D A^YSCEN3
|
|---|
| 70 | G:Y<1!($G(POP))!(YSTOUT)!(YSUOUT) END
|
|---|
| 71 | I $D(IO("Q")) K IO("Q") S ZTRTN="ENQ^YSCEN2",ZTDESC="YS IP" F YSJ="T6","P1","W1","W2","Q3","YSWHO","YSCR" S ZTSAVE(YSJ)=""
|
|---|
| 72 | I D ^%ZTLOAD W !,$S($D(ZTSK):"QUEUED",1:"Not queued"),$C(7) G END
|
|---|
| 73 | ENQ ;
|
|---|
| 74 | D FS0^YSCEN:W1 W @IOF K YSOPT1,YSOPT2 S P1=1 D:T6?1N.N L2,L3 D:T6="S" L2 D:T6="A" L1 K T6 D:IOSL-3>$Y WAIT^YSCEN1
|
|---|
| 75 | ;
|
|---|
| 76 | END0 ; Called by routines YSCEN23, YSCEN24
|
|---|
| 77 | D KILL^%ZTLOAD
|
|---|
| 78 | END ; Called by routines YSCEN23, YSCEN24, YSCEN31, YSCEN35, YSCEN39, YSCEN8
|
|---|
| 79 | ;
|
|---|
| 80 | K C,D,DIYS,G3,N3,S,V,%Y,Y,Z1,ZTSK,ZTIO,C1,C7,DIE,DIC,DR,DIK,I,I7,N,N1,Q3,R,T6,W2,W4,X1,X2,YSB,YSCR,YSJ,YSOPT9L,YSWHO,YSOP,YSOPT1,YSOPT1L,YSOPT2,W1,YSDFN,YSDOB,YSDTM,YSSEX,YST,I1,I2,L1,L2,L3,L4,A6,S2,S5,YSTB,YSDISP,YSFA
|
|---|
| 81 | K YSAC,YSBLN,M,YSAOR,YSC1,YSTLE,YSTMX,YSNM,YSSSN,YSAGE,X,G2,G,F,P,YSCOP,YSCOPY,YSF4,YSPDX,A5,J,L,T,YSENT,YSG,YSGL1,YSPE,YSPOIN,YSTP,YSTM,YSDOT,YSFHDR,YSIDT,YSPPL,YSPST,YSPSV,YSPY,YSPZ,YSX,YSYDT,Z,YSBID
|
|---|
| 82 | K G10,G11,YSFFS,YSDA,YDA,VA D KVAR^VADPT W !! D ^%ZISC
|
|---|
| 83 | Q
|
|---|
| 84 | ENALL ;
|
|---|
| 85 | K IOP,YSOPT1,YSOPT2 S %ZIS="Q" D ^%ZIS G:POP END
|
|---|
| 86 | I $D(IO("Q")) K IO("Q") S ZTRTN="ENALQ^YSCEN2",ZTDESC="YS IP",ZTIO=IO D ^%ZTLOAD W !,$S($D(ZTSK):"QUEUED",1:"Not queued"),$C(7) G END
|
|---|
| 87 | ENALQ ;
|
|---|
| 88 | S W1=0 U IO W @IOF F S W1=$O(^YSG("CEN",W1)) Q:'W1 I '$P(^(W1,0),U,13) S P1=0 D FS0^YSCEN S P1=1 D L1 Q:Q3
|
|---|
| 89 | G END0
|
|---|
