source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCEN2.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1YSCEN2 ;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
3UN ;
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
9L1 ; 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 ;
15L2 ; 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 ;
23L3 ; 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 ;
28L6 ;
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 ;
32L7 ;
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
40L8 ;
41 D:$Y<3 H1 W !!,"No patients" Q
42 ;
43H1 ; 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
49H12 ;
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
53TIME ; 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
57D3 ; 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 ;
63EN ; 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"
68EN1 ;
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
73ENQ ;
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 ;
76END0 ; Called by routines YSCEN23, YSCEN24
77 D KILL^%ZTLOAD
78END ; 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
84ENALL ;
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
87ENALQ ;
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
Note: See TracBrowser for help on using the repository browser.