source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCEN22.m@ 1452

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

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1YSCEN22 ;ALB/ASF,ALB/XAK,ALB/MJK-LONG PRINTOUT ;4/16/92 10:01 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3EN ;
4 D LG^YSCEN23
5ZZ ;
6 S (G0,G1,G2,G3,G4)=0 F ZZ=0:1:4 S:$D(^YSG("INP",DA,ZZ)) @("G"_ZZ)=^YSG("INP",DA,ZZ)
7 W !!,"Ward: ",$P(^DIC(42,W1,0),U),?40,"Entry: " S Y=$P(G0,U,3) D ENDD^YSUTL W $P(Y," ") I $D(^DPT(YSDFN,.101)) S X=$S($X+16>IOM:"!",1:"?$X+2") W @X,"Bed: ",^(.101)
8 S Y=$P(G1,U) W !,$S(Y?1"v".E:"Voluntary patient",Y?1"i".E:"Involuntary patient",1:"Voluntary status undefined") S Y=$P(G1,U,2) W ?40,$S(Y?1"o".E:"Open ward",Y?1"c".E:"Closed ward",1:"open/closed undefined")
9 S Y=$P(G1,U,3) I Y?1N W " Level: ",Y
10 W !,"Team: ",$S($P(G0,U,4)?1N.N:$P(^YSG("SUB",$P(G0,U,4),0),U),1:"UNASSIGNED")
11 I $P(G0,U,4) S G5=$P(^YSG("SUB",$P(G0,U,4),0),U,10) W ?40,$S(G5]"":G5,1:"Staff"),": " S X=$P(G0,U,5) D:X?1N.E D3^YSCEN2
12 I G1'=0 W !,"Hair: ",$P(G1,U,6),?15,"Eyes: ",$P(G1,U,7),?40,"Ht: ",$P(G1,U,8),?50,"Wt: ",$P(G1,U,9)
13 I G2 W !,"Physical Description: ",G2
14 W:G3'=0 !,"** Medical Alert: ",G3 W:G4'=0 !,"Special Diet: ",G4
15PT ;
16 W !,"Team history for this MH ward admission: " S X=0 F S X=$O(^YSG("INP",DA,6,X)) Q:'X S YSTP1=+^(X,0),Y=$P(^(0),U,2) W !?3,X,". ",$P(^YSG("SUB",YSTP1,0),U)," on " D DD^%DT W Y K YSTP1
17 ;
18COM ; Called by routines YSCEN1, YSCEN24, YSCEN54
19 ;
20 K ^UTILITY($J,"W"),G0,G1,G2,G3,G4,G5 S YDA=DA Q:'$D(^YSG("INP",YDA,"AB")) W !?7,"Inpatient Comments:" S G0=0,DIWL=3,DIWR=75,DIWF="WR"
21 F S G0=$O(^YSG("INP",YDA,"AB",G0)) Q:'G0 S G1=0 F S G1=$O(^YSG("INP",YDA,"AB",G0,G1)) Q:'G1 W !! D COM1
22 K G0,G1,G2 Q
23COM1 ;
24 S G2=0 F S G2=$O(^YSG("INP",YDA,5,G1,1,G2)) Q:'G2 S X=^(G2,0) D ^DIWP
25 D ^DIWW K ^UTILITY($J,"W") W "Entered by: ",$P(^VA(200,$P(^YSG("INP",YDA,5,G1,0),U,2),0),U)," on " S (YSTM,YSDTM)=9999999.999999-G0,Y=YSTM\1 D ENDD^YSUTL W Y D ENHM^YSUTL W " at ",YSTM K YSHM Q
26 Q ;K G0,G1,G2,G3,G4,G5 Q
27 ;
28AA ; Called from MENU option YSCENIL
29 ;
30 S (Q3,P,P1)=0,YSOPT2="BB^YSCEN22" D UN^YSCEN2 G:Y<1 END
31AA1 ;
32 W !!,"All patients on ",W2,"? N// " R X:DTIME S YSTOUT='$T,YSUOUT=X["^" G:YSTOUT END
33 S YSR1="X",YSR2="N",YSR3="YN" D ^YSCEN14 G AA1:X="?",END:X=-1,CC:X="N"
34 K IOP S %ZIS="Q" D ^%ZIS G:POP END
35 I $D(IO("Q")) K IO("Q") S ZTRTN="AAQ^YSCEN22",(ZTSAVE("W1"),ZTSAVE("P1"),ZTSAVE("W2"),ZTSAVE("YSOPT2"))="",ZTDESC="YS IP LONG" D ^%ZTLOAD W $S($D(ZTSK):"QUEUED",1:"Not queued"),$C(7) G END
36AAQ ;
37 S P1=0 D FS0^YSCEN S P1=0 D L1^YSCEN2 G END0
38BB ;
39 Q:Q3 S N="" F S N=$O(^UTILITY($J,N)) Q:N="" D B1 Q:Q3
40 Q
41B1 ;
42 S YSDFN=0 F S YSDFN=$O(^UTILITY($J,N,YSDFN)) Q:'YSDFN S DA=^(YSDFN) D EN S W=$P(^DIC(42,W1,0),U) D:IOST?1"C-".E WAIT^YSCEN1 Q:Q3
43 Q
44CC ;
45 K YSOPT2,IOP D FS0^YSCEN,L1^YSCEN2
46 K DIC,DLAYGO,DR,DIE,DA,D S DIC("S")="I $P(^(7),U)=W1",DIC="^YSG(""INP"",",DIC(0)="AEQ",D="CP",DIC("W")="W:X="" "" $P(^DPT($P(^YSG(""INP"",+Y,0),U,2),0),U)" D IX^DIC G:Y<1 END S DA=+Y,YSDFN=$P(^YSG("INP",DA,0),U,2) K DIC
47 S %ZIS="Q" D ^%ZIS G:POP END
48 I $D(IO("Q")) K IO("Q") S ZTRTN="CCQ^YSCEN22",(ZTSAVE("W1"),ZTSAVE("YSDFN"),ZTSAVE("P1"),ZTSAVE("W2"),ZTSAVE("YSOPT2"))="",ZTDESC="YS IP LONG" D ^%ZTLOAD W $S($D(ZTSK):"QUEUED",1:"Not queued"),$C(7) G END
49CCQ ;
50 D EN
51END0 ;
52 D KILL^%ZTLOAD
53END ;
54 K ZTSK,YSDFN,DIC,G,G1,G2,G3,I,Q3,YSOPT1,YSOPT2,Y,J,K,X,C1,DA,P,P1,R,T6,W1,W2,X1,YSSSN,YSTM,N,W,^UTILITY($J),YSBID,VA,PTI D KVAR^VADPT W ! D ^%ZISC Q
Note: See TracBrowser for help on using the repository browser.