source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCEN35.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1YSCEN35 ;DAL/DRF-RX PROFILE BY TEAM ;4/3/90 10:27 ;
2 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
3 ;
4 ; Called from the top by MENU option YSCENMEDS
5STST ;
6 D EN,OUT G END^YSCEN2
7EN ;
8 R !,"How many lines between patients? 3// ",YSF4:DTIME S YSTOUT='$T,YSUOUT=YSF4["^" Q:YSTOUT!(YSUOUT) S YSR1="YSF4",YSR2=3,YSR3=20 D ^YSCEN14 G EN:YSF4="?" Q:YSF4=-1
9DSP ;
10 R !,"Display Primary DX ? Y// ",F:DTIME S YSTOUT='$T,YSUOUT=F["^" Q:YSTOUT!(YSUOUT) S YSR1="F",YSR2="Y",YSR3="YN" D ^YSCEN14 G DSP:F="?" Q:F=-1 S F=F'="N"
11DRUG ;
12 K YSDRT W !?5,"Display",!,"(T)otal prescriptions on file, all (A)ctive prescriptions only, or",!,"(C)urrent active prescriptions only? (Current means filled within last 45 days.)"
13 ;R !!?5,"OPTION: Active only// ",YSDR:60 G:YSDR="^"!'$T END G:(YSDR'?1"A".E)&(YSDR]"")&(YSDR'?1"C".E)&(YSDR'?1"T".E) DRUG S:(YSDR?1"C".E) YSDRT=1 S:(YSDR?1"A".E)!(YSDR="") YSDRT=2 S:(YSDR?1"T".E) YSDRT=3 W !!
14 R !!?5,"Option: Active only// ",YSDR:DTIME S YSTOUT='$T,YSUOUT=YSDR["^" G END:YSTOUT!(YSUOUT) S YSR1="YSDR",YSR2="A",YSR3="ACT" D ^YSCEN14 G DRUG:YSDR="?",END:YSDR=-1 S YSDRT=$S(YSDR="A":2,YSDR="C":1,1:3) W !!
15 D A^YSCEN3 G:$G(Y)<1!($G(POP)) END U IO(0) D COPIES^YSCEN1 G:YSCOP'>0 END
16 I $D(IO("Q")) K IO("Q") S ZTRTN="A1^YSCEN35" F ZZ="P1","W1","W2","T6","F","YSCOP","YSF4","YSCR","YSWHO","YSDR","YSDRT" S ZTSAVE(ZZ)="",ZTDESC="YS IP DRG PROFILE"
17 I D ^%ZTLOAD W !,$S($D(ZTSK):"QUEUED",1:"Not queued"),$C(7) G END
18A1 ;
19 U IO S Q3=0 K YSOPT1,YSOPT2,^UTILITY($J),^UTILITY("YSCEN",$J) I T6?1N.N F YSCOPY=1:1:YSCOP S P=0 D L2^YSCEN2,L3
20 I T6="S" S YSOPT2="L3^YSCEN35" F YSCOPY=1:1:YSCOP W @IOF D S1^YSCEN26
21 I T6="A" S YSAOR=0 F S YSAOR=$O(^YSG("SUB","AOR",W1,YSAOR)) Q:'YSAOR S T6=$O(^(YSAOR,0)) Q:'T6!Q3 K ^UTILITY($J) F ZZ=1:1:YSCOP D L2^YSCEN2,L3,WAIT^YSCEN1:$Y+7<IOSL
22 D KILL^%ZTLOAD
23END ;
24 K C,C1,C7,DIYS,F,G,G2,I,N1,P,P1,Q3,T6,W1,W2,W4,X,Y,YSAGE,YSCOP,YSCOPY,YSCTN,YSDFN,YSDOB,YSDR,YSDRT,YSDTM,YSF4,YSNM,YSPDX,YSPYST0,YSSEX,YSSSN,YSTM,YSTMX,IOP,YSBID D KVAR^VADPT Q
25L3 ;
26 D H1 S N1="" F S N1=$O(^UTILITY($J,N1)) Q:N1=""!Q3 D
27 .S YSDFN=0 F S YSDFN=$O(^UTILITY($J,N1,YSDFN)) Q:'YSDFN S DA=^(YSDFN) D L7 Q:Q3
28 Q
29L7 ;
30 I $Y>(IOSL-YSF4-7) D WAIT^YSCEN1 Q:Q3 D H1
31 D ENPT^YSUTL S G=^YSG("INP",DA,0),G1=$G(^YSG("INP",DA,1)) W !,YSNM,?30,YSBID,?37,YSAGE
32 S X=$P(G,U,3),X(1)=$$FMTE^XLFDT(X,"5ZD") W ?41,X(1),$P(G1,U),$P(G1,U,2),$P(G1,U,3)
33 S X1=DT,X2=X D ^%DTC W ?53,$J(X,4) S X=$P(G,U,5) W ?59 D:X?1N.N D3^YSCEN2 W:$D(^DPT(YSDFN,.101)) ?75,^(.101)
34 S YSPDX=0 I F D PDX^YSCEN6 I 'YSPDX W !,"No primary Dx"
35 W:YSPDX !,YSPDX(4)," Primary DX: ",YSPDX(3)," ",$E(YSPDX(1),1,30)," on ",$$FMTE^XLFDT(YSPDX(2),"5ZD")
36DRUGS ;
37 D ^YSCEN36
38 F ZZ=1:1:YSF4 W !
39 F ZZ=1:1:11 W "======="
40 Q
41H1 ;
42 W @IOF,?10,W2 W:$D(YSOPT1L) ?$X+2,YSOPT1L W ?$X+2,"Patient List " D TIME^YSCEN2 S G2=^YSG("SUB",T6,0)
43 W !,$P(G2,U),?20,YSTM," patients",?35,$P(^YSG("SUB",T6,1),U,3)," beds",?45,"Team Leader: " S X=$P(G2,U,9) D D3^YSCEN2 W !,"Physician: " S X=$P(G2,U,2) D D3^YSCEN2 W ?33,"Psychologist: " S X=$P(G2,U,3) D D3^YSCEN2
44H12 ;
45 W !?3,"name",?30,"SSN",?36,"age",?41,"entered",?53,"days",?59,$S(T6?1N.N:$P(^YSG("SUB",T6,0),U,10),1:""),?75,"bed",!
46 F C1=1:1:11 W "-------"
47 Q
48OUT ;
49 K A,C,C1,C7,YSDRT,DIYS,F,N1,P,R,W2,Q3,W4,YSCOP,YSCOPY,YSCTN,YSDFN,YSDOB,YSDR,YSDTM,YSF4,YSPDX,YSPYST0,YSSEX,YSTM,YSTMX
50 Q
Note: See TracBrowser for help on using the repository browser.