source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCEN23.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.8 KB
Line 
1YSCEN23 ;ALB/ASF-MH CENSUS PATIENT LIST ;4/16/92 10:02 ;08/12/93 17:03
2 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
3 ;
4 ; Called from the top by MENU option YSCENWL
5 ;
6LNS ;
7 R !,"How many lines between patients? 3// ",YSF4:DTIME S YSTOUT='$T,YSUOUT=YSF4["^" G:YSTOUT!(YSUOUT) END^YSCEN2
8 S YSR1="YSF4",YSR2=3,YSR3=20 D ^YSCEN14 G LNS:YSF4="?",END^YSCEN2:YSF4=-1
9DSP ;
10 R !,"Display Primary DX ? Y// ",F:DTIME S YSTOUT='$T,YSUOUT=F["^" G:YSTOUT!(YSUOUT) END^YSCEN2
11 S YSR1="F",YSR2="Y",YSR3="YN" D ^YSCEN14 G DSP:F="?",END^YSCEN2:F=-1 S F=$S(F="N":0,1:1)
12 D A^YSCEN3 I YSTOUT!YSUOUT G END^YSCEN2
13 G:Y<1!($G(POP)) END^YSCEN2 U IO(0) D COPIES^YSCEN1 G:YSCOP'>0 END^YSCEN2
14 I $D(IO("Q")) K IO("Q") S ZTRTN="A1^YSCEN23",Q3=0 F ZZ="P1","W1","W2","T6","F","Q3","YSCOP","YSF4","YSCR","YSWHO","YSOPT9L" S ZTSAVE(ZZ)="",ZTDESC="YS IP PROFILE"
15 I D ^%ZTLOAD W !,$S($D(ZTSK):"QUEUED",1:"Not queued"),$C(7) G END^YSCEN2
16A1 ;
17 U IO
18 S:'$D(W1) W1=0 D:W1 FS0^YSCEN K YSOPT1,YSOPT2 S YSOPT1L="WORK LIST" I T6'?1A F YSCOPY=1:1:YSCOP W @IOF S P=0 D L2^YSCEN2,L3,WAIT^YSCEN1
19 I T6="S" S YSOPT2="L3^YSCEN23,WAIT^YSCEN1" F YSCOPY=1:1:YSCOP W @IOF D S1^YSCEN26
20 I T6="A" S YSC1=0 F S YSC1=$O(^YSG("SUB","AOR",W1,YSC1)) Q:'YSC1 S T6=$O(^(YSC1,0)) Q:'T6!Q3 D:'$P(^YSG("SUB",T6,1),U,5) A11,WAIT^YSCEN1:$Y+2<IOSL
21 K T6,W1,IOP G END0^YSCEN2
22A11 ;
23 K ^UTILITY($J) F YSCOPY=1:1:YSCOP W @IOF D L2^YSCEN2,L3,WAIT^YSCEN1:$Y+4+YSF4>IOSL
24 Q
25L3 ;
26 D H1^YSCEN2 I '$D(^UTILITY($J)) W !!,"No Patients",$C(7) Q
27 S N1="" F S N1=$O(^UTILITY($J,N1)) Q:N1=""!Q3 D
28 .S YSDFN=0 F S YSDFN=$O(^UTILITY($J,N1,YSDFN)) Q:'YSDFN S DA=^(YSDFN) D L7 Q:Q3
29 Q
30L7 ;
31 I $Y>(IOSL-YSF4-7) D WAIT^YSCEN1 Q:Q3 D H1^YSCEN2
32 D ENPT^YSUTL S G=^YSG("INP",DA,0) W !,YSNM,?30,YSBID,?35,$J(YSAGE,3)
33 S X=$P(G,U,3),X(1)=$$FMTE^XLFDT(X,"5ZD") W ?39,X(1)
34 I $D(^YSG("INP",DA,1)) S G1=^(1) W $P(G1,U),$P(G1,U,2),$P(G1,U,3) K G1
35 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^YSCEN2 W:$D(^DPT(YSDFN,.101)) ?70,^(.101)
36 S YSPDX=0 I F D PDX^YSCEN6 I 'YSPDX W !,"No primary Dx"
37 W:YSPDX !,YSPDX(4)," Primary DX: ",YSPDX(3)," ",$E(YSPDX(1),1,30)," on ",$$FMTE^XLFDT(X,"5ZD")
38 F ZZ=1:1:YSF4 W !
39 F ZZ=1:1:10 W "========"
40 Q
41LG ; Called by routine YSCEN22
42 ;
43 S PTI(0)=^DPT(YSDFN,0) S DFN=YSDFN D DEM^VADPT,PID^VADPT
44 S PTI(.11)=$G(^DPT(YSDFN,.11)),PTI(.13)=$G(^(.13)),I=+$P(PTI(0),U,3),PTI(.362)=$G(^(.362)),PTI(.361)=$P($G(^(.361)),U),YSSSN=VA("PID")
45 I $D(^DPT(YSDFN,.121)) S X=$S($P(^(.121),U,8):$P(^(.121),U,8),1:9999999) I DT'<$P(^(.121),U,7),DT'>X S PTI(.11)=^(.121),YSADR=""
46 I '$D(IOF) S IOP=IO D ^%ZIS K IOP Q:POP
47 U IO W @IOF,!,VADM(1),?32,"SSN: ",YSSSN,?58,"DOB: ",$P(VADM(3),U,2) ;MAS PATCH (PID)
48 W !,$P(PTI(.11),U),?32,"C-#: ",$S($D(^DPT(YSDFN,.31)):$P(^(.31),U,3),1:"Unknown"),?53,"Religion: ",$E($P($G(^DIC(13,+$P(PTI(0),U,8),0)),U),1,17)
49 W !,$P(PTI(.11),U,4),?42,"Elig: " I $D(^DPT(YSDFN,.36)),$D(^DIC(8,+^(.36),0)) W $P(^(0),U)
50 W !,$P($G(^DIC(5,+$P(PTI(.11),U,5),0)),U)
51 W " ",$$ZIP4^YSPP(+YSDFN,1),?42,"HB:",$P(PTI(.362),U,2),?55,"A&A:",$P(PTI(.362),U)
52 W !,"PHONE: ",$P(PTI(.13),U),?42,"***ELIGIBILITY ",$S(PTI(.361)="P":"PENDING VERIFICATION",PTI(.361)="R":"PENDING RE-VERIFICATION",PTI(.361)="V":"VERIFIED",1:"NOT VERIFIED"),"***"
53 ;I $D(YSADR) S YSEND=$P(PTI(.11),U,8) W !,"(Temporary Address - ",$S('YSEND:"no end date",1:"until "_$E(YSEND,4,5)_"/"_$E(YSEND,6,7)_"/"_$E(YSEND,2,3)),")" K YSADR,YSEND
54 I $D(YSADR) S YSEND=$P(PTI(.11),U,8) W !,"(Temporary Address - ",$S('YSEND:"no end date",1:"until "_$$FMTE^XLFDT(X,"5ZD")),")" K YSADR,YSEND
55 Q:'$D(^DPT(YSDFN,.33)) S PTI(.33)=^(.33) W !!,"Emergency Contact: ",$P(PTI(.33),U),?42,"E-Relationship: ",$P(PTI(.33),U,2)
56 W !,"E-Address: ",$P(PTI(.33),U,3),?42,"E-Phone: ",$P(PTI(.33),U,9) W:$P(PTI(.33),U,4)]"" !?10,$P(PTI(.33),U,4),?42,$P(PTI(.33),U,5) W !?3,$P(PTI(.33),U,6),?$X+3
57 W ?$X+3,$P($G(^DIC(5,+$P(PTI(.33),U,7),0)),U,2),?$X+2,$$ZIP4^YSPP(+YSDFN,4)
Note: See TracBrowser for help on using the repository browser.