| [613] | 1 | YSCEN22 ;ALB/ASF,ALB/XAK,ALB/MJK-LONG PRINTOUT ;4/16/92 10:01 ;
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
|---|
| 3 | EN ;
|
|---|
| 4 | D LG^YSCEN23
|
|---|
| 5 | ZZ ;
|
|---|
| 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
|
|---|
| 15 | PT ;
|
|---|
| 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 | ;
|
|---|
| 18 | COM ; 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
|
|---|
| 23 | COM1 ;
|
|---|
| 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 | ;
|
|---|
| 28 | AA ; Called from MENU option YSCENIL
|
|---|
| 29 | ;
|
|---|
| 30 | S (Q3,P,P1)=0,YSOPT2="BB^YSCEN22" D UN^YSCEN2 G:Y<1 END
|
|---|
| 31 | AA1 ;
|
|---|
| 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
|
|---|
| 36 | AAQ ;
|
|---|
| 37 | S P1=0 D FS0^YSCEN S P1=0 D L1^YSCEN2 G END0
|
|---|
| 38 | BB ;
|
|---|
| 39 | Q:Q3 S N="" F S N=$O(^UTILITY($J,N)) Q:N="" D B1 Q:Q3
|
|---|
| 40 | Q
|
|---|
| 41 | B1 ;
|
|---|
| 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
|
|---|
| 44 | CC ;
|
|---|
| 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
|
|---|
| 49 | CCQ ;
|
|---|
| 50 | D EN
|
|---|
| 51 | END0 ;
|
|---|
| 52 | D KILL^%ZTLOAD
|
|---|
| 53 | END ;
|
|---|
| 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
|
|---|
