source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCEN54.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: 3.1 KB
Line 
1YSCEN54 ;ALB/ASF,ALB/XAK,ALB/MJK-LONG PRINTOUT ;4/4/90 08:29 ;07/28/93 16:26
2 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
3 ;
4EN ; Called from routine YSCEN5
5 S YSEN=1,YY(0)=^DPT(YSDFN,0) D DEM^VADPT,PID^VADPT
6 S Y(.11)=$G(^DPT(YSDFN,.11)),Y(.13)=$G(^(.13)),I=+$P(YY(0),U,3),Y(.362)=$G(^(.362)),Y(.361)=$P($G(^(.361)),U) I $D(^(.121)) S X=$S($P(^(.121),U,8):$P(^(.121),U,8),1:9999999) I DT'<$P(^(.121),U,7),DT'>X S Y(.11)=^(.121),YSADR=""
7 S YSSSN=VA("PID"),YSBID=VA("BID")
8 W @IOF,!,$P(YY(0),U),?32,"SSN: ",YSSSN,?58,"DOB: ",$S(I:$E(I,4,5)_"-"_$E(I,6,7)_"-"_(1700+$E(I,1,3)),1:"UNKNOWN")
9 W !,$P(Y(.11),U),?32,"C-#: ",$S($D(^DPT(YSDFN,.31)):$P(^(.31),U,3),1:"Unknown"),?53,"Religion: ",$E($P($G(^DIC(13,+$P(YY(0),U,8),0)),U),1,17)
10 W !,$P(Y(.11),U,4),?42,"Elig: " I $D(^DPT(YSDFN,.36)),$D(^DIC(8,+^(.36),0)) W $P(^(0),U)
11 W !,$P($G(^DIC(5,+$P(Y(.11),U,5),0)),U)
12 W " ",$$ZIP4^YSPP(+YSDFN,9),?42,"HB:",$P(Y(.362),U,2),?55,"A&A:",$P(Y(.362),U)
13 W !,"PHONE: ",$P(Y(.13),U),?42,"***ELIGIBILITY ",$S(Y(.361)="P":"PENDING VERIFICATION",Y(.361)="R":"PENDING RE-VERIFICATION",Y(.361)="V":"VERIFIED",1:"NOT VERIFIED"),"***"
14 I $D(YSADR) S YSEND=$P(Y(.11),U,8) W !,"(Temporary Address - ",$S('YSEND:"no end date",1:"until "_$$FMTE^XLFDT(YSEND,"5ZD")),")" K YSADR,YSEND
15 Q:'$D(^DPT(YSDFN,.33)) S Y(.33)=^(.33) W !!,"Emergency Contact: ",$P(Y(.33),U),?42,"E-Relationship: ",$P(Y(.33),U,2)
16 W !,"E-Adress: ",$P(Y(.33),U,3),?42,"E-Phone: ",$P(Y(.33),U,9) W:$P(Y(.33),U,4)]"" !?10,$P(Y(.33),U,4),?42,$P(Y(.33),U,5) W !?3,$P(Y(.33),U,6),?$X+3
17 W ?$X+3,$P($G(^DIC(5,+$P(Y(.33),U,7),0)),U,2),?$X+2,$$ZIP4^YSPP(+YSDFN,4) Q
18 ;
19ZZ ; Called from routines YSCEN52, YSCEN53
20 D HDD F ZZ=0:1:4,7 S @("G"_ZZ)=$G(^YSG("INP",DA,ZZ))
21 I $P(G7,U,4) W !?10,"*** Current Admission ***",!
22 W:G7 !,"Ward: ",$P(^DIC(42,+G7,0),U) W ?40,"Entry: " S Y=$P(G0,U,3) D ENDD^YSUTL W $P(Y," ")
23 S Y=$P(G7,U,2) I Y?7N.E D ENDD^YSUTL W !?40,"Discharged: ",Y
24 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")
25 S Y=$P(G1,U,3) I Y?1N W " Level: ",Y
26 W ! W:$P(G7,U,2) "Discharge " W "Team: ",$S($P(G0,U,4)?1N.N:$P(^YSG("SUB",$P(G0,U,4),0),U),1:"UNASSIGNED")
27 W ?40,$S($P($G(^YSG("SUB",+$P(G0,U,4),0)),U,10):$P(^(0),U,10),1:"Staff"),": " S X=$P(G0,U,5) D:X?1N.E D3^YSCEN2
28 I $P(G0,U,6)?1N.N!($P(G0,U,7)?1N.N) W !,"Physician: " S X=$P(G0,U,6) D:X?1N.N D3^YSCEN2 W ?40,"Resident: " S X=$P(G0,U,7) D:X?1N.N D3^YSCEN2
29 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)
30 I G2 W !,"Physical Description: ",G2
31 W:G3 !,"** Medical Alert: ",G3 W:G4 !,"Special Diet: ",G4
32PT ;
33 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
34COM ;
35 D COM^YSCEN22 Q
36HDD ;
37 D ENPT^YSUTL S YY(0)=^DPT(YSDFN,0) I $Y+6>IOSL W @IOF G HDD1
38 W ! F ZZ=1:1:10 W "========"
39HDD1 ;
40 W:'$D(YSEN) !,$P(YY(0),U),?32,"SSN: ",YSSSN,?58,"DOB: ",$S($P(YY(0),U,3):$$FMTE^XLFDT($P(YY(0),U,3),"5ZD"),1:"UNKNOWN")
41 D:'$D(YSEN) CK^YSCEN5 K YSEN Q
Note: See TracBrowser for help on using the repository browser.