source: WorldVistAEHR/trunk/r/ZZOTHER/ZPSSDOSE.m@ 701

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

initial load of WorldVistAEHR

File size: 8.3 KB
Line 
1ZPSSDOSE ;BIR/RTR-Dosage review report ; 8/16/05 4:14pm
2 ;;1.0;PHARMACY DATA MANAGEMENT;**34,38,49**;9/30/97
3 ;Reference to ^PS(50.607 supported by DBIA 2221
4EN ;
5 K PSSHOW,PSSBEG,PSSEND,PSSSRT
6 K DIR S DIR(0)="S^A:ALL;S:SELECT A RANGE",DIR("B")="S",DIR("A")="Print Report for (A)ll or (S)elect a Range" D D ^DIR K DIR I Y["^"!($D(DTOUT))!($D(DUOUT)) W !!,"Nothing queued to print.",! G ENDX
7 .S DIR("?")=" ",DIR("?",1)="Enter 'A' to run report for all dispense drugs. Enter 'S' to select a range",DIR("?",2)="(alphabetically) of dispense drugs to print."
8 .S DIR("?",3)="This report displays Possible Dosage and Local Possible Dosage information for",DIR("?",4)="the dispense drugs in the range selected."
9 S PSSHOW=Y I PSSHOW="A" S PSSBEG="A",PSSEND="Z" S PSSSRT="A" G DEV
10 ;W !!,"To see drugs beginning with the letter 'A', enter 'A', or whichever letter you",!,"wish to see. To see drugs in a range, for example drugs starting with the",!,"letters 'G', 'H', 'I' and 'J', enter in the format 'G-J'.",!
11ASK ;
12 K DIR,PSSBEG,PSSEND,PSSNUMBX
13 S PSSNUMB=""
14 F S PSSNUMB=$O(^PSDRUG("B",PSSNUMB)) Q:'PSSNUMB!($G(PSSNUMBX)) S PSSNUMBX=1
15 I $G(PSSNUMBX) K DIR S DIR(0)="Y",DIR("A")="Print report for drugs with leading numerics",DIR("B")="N" D D ^DIR K DIR I Y["^"!($D(DUOUT))!($D(DTOUT)) W !!,"Nothing queued to print.",! G ENDX
16 .W !!!,"There are drugs in the Drug file with leading numerics.",!
17 .S DIR("?")=" ",DIR("?",1)="There are some entries in the drug file with leading numerics.",DIR("?",2)="Enter Yes to print the report for those drugs.",DIR("?",3)=" "
18 I $G(PSSNUMBX),$G(Y)=1 S PSSSRT="N" G DEV
19 K PSSNUMB,PSSNUMBX
20ASKA K PSSBEG,PSSEND
21 W !!,"To see drugs beginning with the letter 'A', enter 'A', or whichever letter you",!,"wish to see. To see drugs in a range, for example drugs starting with the",!,"letters 'G', 'H', 'I' and 'J', enter in the format 'G-J'.",!
22 S DIR("?",1)=" ",DIR("?",2)="Enter either 1 letter, 'A', 'B', etc., to see drugs beginning with that letter,",DIR("?",3)="or to see a range of drugs enter in the format 'A-C', 'G-M', 'S-Z', etc.",DIR("?",4)=" ",DIR("?")=" "
23 S DIR("A")="Select a Range",DIR(0)="F^1:3" D ^DIR I Y["^"!($D(DTOUT))!($D(DUOUT)) W !!,"Nothing queued to print.",! G ENDX
24 S X=Y I X'?1U&(X'?1U1"-"1U)&(X'?1L)&(X'?1L1"-"1L) W !!,"Invalid response, enter a letter, 'A', 'B', etc., or a range, 'C-F', 'M-R', etc.",! G ASKA
25 I X["-" S PSSBEG=$P(X,"-"),PSSEND=$P(X,"-",2) I $A(PSSEND)<$A(PSSBEG) W !!,"Invalid response.",! G ASKA
26 I X'["-" S PSSBEG=X,PSSEND=X
27 S PSSSRT="X"
28DEV I PSSSRT="X" W !!,"Report will be for drugs starting with the letter "_$G(PSSBEG)_",",!,"and ending with drugs starting with the letter "_$G(PSSEND)_".",!
29 I PSSSRT="N" W !!,"This report will be for drugs with leading numerics.",!
30 I PSSSRT="A" W !!,"This report will be for all drugs.",!
31 K DIR S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="Y" D ^DIR K DIR I Y'=1 W ! G EN
32 W $C(7),!!?3,"This report is designed for 132 column format!",!
33 K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! G ENDX
34 I $D(IO("Q")) S ZTRTN="START^PSSDOSRP",ZTDESC="Dosage Review Report",ZTSAVE("PSSHOW")="",ZTSAVE("PSSBEG")="",ZTSAVE("PSSEND")="",ZTSAVE("PSSSRT")="" D ^%ZTLOAD K %ZIS W !,"Report queued to print.",! G ENDX
35START ;
36 U IO
37 I '$G(DT) S DT=$$DT^XLFDT
38 S X1=DT,X2=-365 D C^%DTC S PSSYEAR=$G(X) K X,X1,X2
39 S PSSOUT=0,PSSDV=$S($E(IOST)="C":"C",1:"P"),PSSCT=1
40 K PSSLINE S $P(PSSLINE,"-",130)=""
41 D HD
42 G:PSSSRT="N" PASS
43 S PSSX=$A(PSSBEG)-1
44 S PSSNAME=$C(PSSX)_"zzzz"
45PASS ;
46 I $G(PSSSRT)="N" S (PSSNAME,PSSEND)=""
47 I $G(PSSSRT)="A" S (PSSNAME,PSSEND)=""
48 F S PSSNAME=$O(^PSDRUG("B",PSSNAME)) Q:$S(PSSSRT="N"&('PSSNAME):1,PSSSRT="X"&(PSSNAME](PSSEND_"zzzz")):1,1:0)!(PSSNAME=""&(PSSSRT="X"))!(PSSSRT="A"&(PSSNAME=""))!($G(PSSOUT)) D
49 .F PSSIEN=0:0 S PSSIEN=$O(^PSDRUG("B",PSSNAME,PSSIEN)) Q:'PSSIEN!($G(PSSOUT)) D
50 ..Q:$D(^PSDRUG(PSSIEN,"I"))
51 ..Q:'$D(^PSDRUG(PSSIEN,0))
52 ..I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
53 ..K PSSINA,PSSNF,PSSINAD,PSSUNIT,PSSAPU S PSSNF=$S($P($G(^PSDRUG(PSSIEN,0)),"^",9):1,1:0),PSSINA=$P($G(^PSDRUG(PSSIEN,"I")),"^"),PSSNODE=$G(^("DOS"))
54 ..I $G(PSSINA),$G(PSSYEAR),$G(PSSINA)<$G(PSSYEAR) Q
55 ..S PSSMSG=$P($G(^PSDRUG(PSSIEN,0)),"^",10)
56 ..S PSSAPU=$P($G(^PSDRUG(PSSIEN,2)),"^",3)
57 ..I $G(PSSINA) S PSSINAD=$E(PSSINA,4,5)_"/"_$E(PSSINA,6,7)_"/"_$E(PSSINA,2,3)
58 ..I $P(PSSNODE,"^",2) S PSSUNIT=$P($G(^PS(50.607,+$P(PSSNODE,"^",2),0)),"^")
59 ..S PSSSTR=$P(PSSNODE,"^")
60 ..; NEW VOE CODE **************
61 ..W !!!,$G(PSSNAME)_U
62 ..I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
63 ..I $G(PSSMSG)'="" W $G(PSSMSG)_U
64 ..I '$O(^PSDRUG(PSSIEN,"DOS1",0)),'$O(^PSDRUG(PSSIEN,"DOS2",0)) Q
65 ..I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
66 ..W "Strength: "_$S($E($G(PSSSTR),1)=".":"0",1:"")_$G(PSSSTR)_U W "Units: " I $G(PSSUNIT)'="",$G(PSSUNIT)'["/" W $G(PSSUNIT)_U
67 ..I $G(PSSUNIT)'="",$G(PSSUNIT)'["/",$L(PSSUNIT)>15
68 ..W "Application Package: "_$G(PSSAPU)_U
69 ..I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
70 ..S PSSA=0 K PSSC,PSSD,PSSE W "Possible Dosages: " I $G(PSSSTR)'="",$G(PSSUNIT)'="" D
71 ...F PSSB=0:0 S PSSB=$O(^PSDRUG(PSSIEN,"DOS1",PSSB)) Q:'PSSB!($G(PSSOUT)) S PSSC=$P($G(^(PSSB,0)),"^"),PSSD=$P($G(^(0)),"^",2),PSSE=$P($G(^(0)),"^",3) I $G(PSSC),$G(PSSD) S PSSA=1 D
72 ....I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
73 ....W "Dispense Units Per Dose: "_$S($E($G(PSSC),1)=".":"0",1:"")_$G(PSSC)_U_"Dose: " D
74 .....I $G(PSSUNIT)'["/" W $S($E($G(PSSD),1)=".":"0",1:"")_$G(PSSD)_$G(PSSUNIT) W U_"Package: "_$G(PSSE)_U D OUT Q
75 .....D SETD D ZERO W $G(PSSCALC)_U_"Package: "_$G(PSSE) D OUT
76 ..Q:$G(PSSOUT)
77 ..I 'PSSA W "(None)"_U
78 ..S PSSA=0 W !,"Local Possible Dosages: " F PSSB=0:0 S PSSB=$O(^PSDRUG(PSSIEN,"DOS2",PSSB)) Q:'PSSB!($G(PSSOUT)) D
79 ...I $P($G(^PSDRUG(PSSIEN,"DOS2",PSSB,0)),"^")'="" S PSSA=1 D
80 ....I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
81 ....W $P($G(^PSDRUG(PSSIEN,"DOS2",PSSB,0)),"^")_U_"Package: "_$P($G(^(0)),"^",2)
82 ..I 'PSSA W "(None)"_U
83END ;
84 I '$G(PSSOUT),$G(PSSDV)="C" W !!,"End of Report." K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
85 I $G(PSSDV)="C" W !
86 E W @IOF
87ENDX K PSSNODE,PSSNUMB,PSSNUMBX,PSSSRT,PSSCALC,PSSSTR,PSSUNIT,PSSIEN,PSSINAD,PSSINA,PSSNF,PSSNAME,PSSDV,PSSX,PSSOUT,PSSHOW,PSSBEG,PSSLINE,PSSEND,PSSA,PSSB,PSSC,PSSD,PSSE,PSSAPU,PSSMSG,PSSYEAR D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
88 Q
89HD ;
90 I $G(PSSDV)="C",$G(PSSCT)'=1 W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSOUT=1 Q
91 W @IOF W !,$S(PSSSRT="N":"Dosage report for drugs with leading numerics",PSSSRT="A":"Dosage report for all drugs",1:"Dosage report for drugs from "_PSSBEG_" through "_PSSEND)
92 W ?94,"Outpatient Expansion",?119,"PAGE: "_$G(PSSCT),!,PSSLINE S PSSCT=PSSCT+1
93 Q
94SETD ;
95 N PSSVA,PSSVA1,PSSVB,PSSVB1,PSSDASH,PSSNDFS,PSSDASH2,PSSDASH3,PSSDASH4,PSSDASH5 K PSSCALC
96 S PSSDASH=0 S PSSNDFS=$$PSJST^PSNAPIS(+$P($G(^PSDRUG(PSSIEN,"ND")),"^"),+$P($G(^PSDRUG(PSSIEN,"ND")),"^",3)) S PSSNDFS=+$P($G(PSSNDFS),"^",2) I $G(PSSNDFS),$G(PSSSTR),+$G(PSSSTR)'=+$G(PSSNDFS) S PSSDASH=1
97 S PSSVA=$P(PSSUNIT,"/"),PSSVB=$P(PSSUNIT,"/",2),PSSVA1=+$G(PSSVA),PSSVB1=+$G(PSSVB)
98 I $G(PSSDASH) S PSSDASH2=PSSSTR/PSSNDFS,PSSDASH3=PSSDASH2*PSSC S PSSDASH4=PSSDASH3*$S($G(PSSVB1):PSSVB1,1:1) S PSSDASH5=$S('$G(PSSVB1):PSSDASH4_$G(PSSVB),1:PSSDASH4_$P(PSSVB,PSSVB1,2))
99 S PSSCALC=$S('$G(PSSVA1):PSSD,1:($G(PSSVA1)*PSSD))_$S($G(PSSVA1):$P(PSSVA,PSSVA1,2),1:PSSVA)_"/"_$S($G(PSSDASH):$G(PSSDASH5),'$G(PSSVB1):+$G(PSSC)_$G(PSSVB),1:(+$G(PSSC)*+PSSVB1)_$P(PSSVB,PSSVB1,2))
100 Q
101OUT ;
102 K PSSDFOI,PSSDFOIN,PSSDF,PSSDZZ
103 Q:$G(PSSE)'["O"
104 S PSSDFOI=$P($G(^PSDRUG(PSSIEN,2)),"^") Q:'PSSDFOI
105 S PSSDF=$P($G(^PS(50.7,+PSSDFOI,0)),"^",2)
106 S PSSDFOIN=$P($G(^PS(50.606,+$G(PSSDF),0)),"^")
107 Q:'PSSDF
108 K PSSDZ F PSSDZZ=0:0 S PSSDZZ=$O(^PS(50.606,PSSDF,"NOUN",PSSDZZ)) Q:'PSSDZZ!($G(PSSDZ)'="") I $P($G(^(PSSDZZ,0)),"^")'="" S PSSDZ=$P($G(^(0)),"^")
109 I $G(PSSDZ)="" S PSSDZ=$G(PSSDFOIN)
110 I $G(PSSC) D PARN
111 W ?94,$G(PSSC)_" "_$S($G(PSSDZN)'="":$G(PSSDZN),1:$G(PSSDZ))
112 K PSSDFOI,PSSDF,PSSDZ,PSSDZZ,PSSDZN,PSSDZNX,PSSDFOIN
113 Q
114PARN ;
115 K PSSDZN,PSSDZNX
116 Q:$G(PSSDZ)=""
117 Q:$L(PSSDZ)'>3
118 S PSSDZNX=$E(PSSDZ,($L(PSSDZ)-2),$L(PSSDZ))
119 I $G(PSSDZNX)="(S)"!($G(PSSDZNX)="(s)") D
120 .I $G(PSSC)'>1 S PSSDZN=$E(PSSDZ,1,($L(PSSDZ)-3))
121 .I $G(PSSC)>1 S PSSDZN=$E(PSSDZ,1,($L(PSSDZ)-3))_$E(PSSDZNX,2)
122 Q
123ZERO ;Leading zeros
124 I $E($G(PSSCALC),1)="." S PSSCALC="0"_$G(PSSCALC)
125 N PSSLEZ,PSSLEZ1,PSSLEZD
126 I $G(PSSCALC)["/." S PSSLEZD=$G(PSSCALC) D
127 .S PSSLEZ=$P(PSSLEZD,"/."),PSSLEZ1=$P(PSSLEZD,"/.",2)
128 .S PSSCALC=$G(PSSLEZ)_"/0."_$G(PSSLEZ1)
129 Q
Note: See TracBrowser for help on using the repository browser.