source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCEN36.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.6 KB
Line 
1YSCEN36 ;DAL/DRF-MH Census Medication Lookup ;4/3/90 10:27 ;
2 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
3 ;
4 ; Called by routine YSCEN35
5EN ;
6 I '$D(^PS(55,YSDFN,"P",0)) W !!?23,"** No prescriptions on file **" Q
7 D HEAD,EN1,CURRENT G OUT
8 Q
9EN1 ;
10 S YSCRX=0,YSDRUG=0
11 S ZZ=0 F S ZZ=$O(^PS(55,YSDFN,"P",ZZ)) Q:'ZZ S (YSRXNO,J)=+^(ZZ,0) I $D(^PSRX(YSRXNO,0)) S YSRXGL=^PSRX(YSRXNO,0),YSRXGL2=^(2),YSFDAT=+(^(3)) D STAT S (YSRXNO,J)=$P(YSRXGL,U) D:YSDRT=3 YSDRUG1 D:YSDRT=2 YSDRUG D:YSDRT=1 YSDRUG0
12 Q
13YSDRUG0 ;
14 S X=-45,%DT="" D ^%DT S YSDAT=Y Q:YSFDAT<YSDAT D YSDRUG
15 Q
16YSDRUG ;
17 Q:ST'="Active" D YSDRUG1
18 Q
19YSDRUG1 ;
20 S YSRX1=$P(YSRXGL,U,6) Q:'YSRX1 S YSDRUG=$P(^PSDRUG(YSRX1,0),U),YSIG=$P(YSRXGL,U,10),YSQTY=$P(YSRXGL,U,7),YSREM=$P(YSRXGL,U,9)-$P($G(^PSRX(YSRXNO,1,0)),U,4) D YSDRUG2
21 Q
22YSDRUG2 ;
23 S YSPHY=$P($P(^VA(200,($P(YSRXGL,U,4)),0),U),","),YSCF=$J(($P(YSRXGL,U,7)*($P(YSRXGL,U,17))),3,2),YSCF=" unavail" S:YSDRUG'=0 YSCRX=1 D YSDRUG3 ;"When drug cost accurate, remove YSCF=" unavail", replace with YSCF
24 Q
25YSDRUG3 ;
26 D DATE S YSPYST0=$P(YSRXGL,U,3),YSPST=$S(YSPYST0="7":"Pass",YSPYST0="17":"Self",YSPYST0="1":"SC",YSPYST0="3":"SC<50%",YSPYST0="5":"OptNSC",YSPYST0="9":"Inpt",YSPYST0="11":"Reg D/C",YSPYST0="15":"AmbCare",1:"Z")
27 I YSPST="Z" S YSPST=$S(YSPYST0="4":"PenNSC",YSPYST0="2":"A&A/WWI",YSPYST0="6":"OthFed",YSPYST0="8":"AA>96hr",YSPYST0="10":"Emplye",YSPYST0="12":"NBC",YSPYST0="13":"PBC",YSPYST0="14":"CNH",YSPYST0="18":"HB/HC",1:"Other")
28 D WRITE
29 Q
30WRITE ;
31 I (IOST["P-")&($Y>(IOSL-9)) W @IOF D HEAD
32WRITE0 ;
33 S (YSCNT,YSCTN)=0 W !,YSRXNO G:$L(YSDRUG)>30 DWRAP I YSCTN<1 W ?9,YSDRUG G WRITE1
34 Q
35WRITE1 ;
36 W ?42,$E(YSPHY,1,10),?53,YSWDAT,?65,YSQTY,?70,YSPST,?77,YSREM G:YSCTN<1 WRITE2
37 Q
38WRITE2 ;
39 G:$L(YSIG)>32 WRAP W !?2,"Sig: ",YSIG W:YSDRT=3 ?40,"RxStat: ",ST W ?59,"Cost/Fill: $",YSCF
40 Q
41HEAD ;
42 W !!," RxNo" W:YSDRT=1 ?11,"Current Active Prescriptions" W:YSDRT=2 ?13,"Active Prescriptions" W:YSDRT=3 ?12,"Prescriptions on File" W ?43,"Phys",?52," Filldate",?63,"#Disp",?69,"Type",?76,"Rem"
43HEAD1 W !,"-----" W:YSDRT=1 ?11,"----------------------------" W:YSDRT=2 ?13,"--------------------" W:YSDRT=3 ?12,"----------------------" W ?43,"----",?53,"--------",?63,"-----",?69,"----",?76,"---"
44 Q
45DATE ;
46 S YSWDAT=$$FMTE^XLFDT(YSFDAT,"5ZD")
47 Q
48CURRENT ;
49 I YSCRX=0 W:YSDRT=1 !!?10,"** No Current Active Prescriptions on File **" W:YSDRT=2 !!?10,"** No Active Prescriptions on File **" W:YSDRT=3 !!?10,"** No Prescriptions on File **"
50 Q
51OUT ;
52 K YSCF,YSCHAR,YSCNT,YSCRX,Y,YSDRUG,YSDRUG2,YSFDAT,YSLDRUG,I,J,YSKK,YSLIG,YSLL,YSPHY,YSPST,YSQTY,YSDAT,YSIG,YSIG1,YSREM,YSRX1,YSRXGL,YSRXGL2,YSRXNO,ST,YST0,YSWDAT,X
53 Q
54STAT ;
55 S YST0=$P(YSRXGL,U,15) D:YST0<12&($D(^PS(52.5,"B",J))) STAT1 S:YST0<12&(DT>$P(YSRXGL2,U,6)) YST0=11
56 S ST=$P("Error^Active^Fill^Refill Fill^Hold^^Suspended^^^^^Done^Expired^Cancelled",U,YST0+2),YSRXGL=$P(YSRXGL_"^^^^^^^^^^^^",U,1,14)_U_YST0_U_$P(YSRXGL,U,16,99)
57 Q
58STAT1 ;
59 I $O(^PS(52.5,"B",J,0)),$D(^PS(52.5,$O(^(0)),0)),'$D(^("P")) S YST0=5
60 Q
61WRAP ;
62 S YSCNT=YSCNT+1,YSLIG=$L(YSIG),YSIG1="" F YSKK=1:1:YSLIG S YSCHAR=$E(YSIG,YSKK) Q:(YSCHAR=$C(32)&(YSKK>25)) S YSIG1=YSIG1_YSCHAR
63 W:YSCNT=1 !?2,"Sig:" W:YSCNT>1 ! W ?7,YSIG1 W:(YSCNT=1)&(YSDRT=3) ?40,"RxStat: ",ST W:(YSCNT=1) ?59,"Cost/Fill: $",YSCF S YSIG=$E(YSIG,(YSKK+1),YSLIG) G:$L(YSIG)>32 WRAP W:$L(YSIG)'>32 !?7,YSIG
64 Q
65DWRAP ;
66 S YSCTN=YSCTN+1 S YSLDRUG=$L(YSDRUG),YSDRUG2="" F YSLL=1:1:YSLDRUG S YSCHAR=$E(YSDRUG,YSLL) Q:(YSCHAR=$C(32)&(YSLL>22)) S YSDRUG2=YSDRUG2_YSCHAR
67 W:YSCTN>1 ! W ?9,YSDRUG2 D:YSCTN=1 WRITE1 S YSDRUG=$E(YSDRUG,(YSLL+1),YSLDRUG) G:$L(YSDRUG)>30 DWRAP W:$L(YSDRUG)'>30 !?9,YSDRUG
68 I YSCTN>0 G WRITE2
69 Q
Note: See TracBrowser for help on using the repository browser.