source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSOIDOS.m@ 1006

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

initial load of WorldVistAEHR

File size: 7.7 KB
Line 
1PSSOIDOS ;BIR/RTR-Orderable Item/Dosage review report ;03/24/00
2 ;;1.0;PHARMACY DATA MANAGEMENT;**40**;9/30/97
3EN ;
4 K PSSHOW,PSSBEG,PSSEND,PSSSRT
5 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
6 .S DIR("?")=" ",DIR("?",1)="Enter 'A' to run report for all Orderable Items. Enter 'S' to select a range",DIR("?",2)="(alphabetically) of Orderable Items to print."
7 S PSSHOW=Y I PSSHOW="A" S PSSBEG="A",PSSEND="Z" S PSSSRT="A" G DEV
8 ;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'.",!
9ASK ;
10 K DIR,PSSBEG,PSSEND,PSSNUMBX
11 S PSSNUMB=""
12 F S PSSNUMB=$O(^PS(50.7,"B",PSSNUMB)) Q:'PSSNUMB!($G(PSSNUMBX)) S PSSNUMBX=1
13 I $G(PSSNUMBX) K DIR S DIR(0)="Y",DIR("A")="Print report for Orderable Items with leading numerics",DIR("B")="N" D D ^DIR K DIR I Y["^"!($D(DUOUT))!($D(DTOUT)) W !!,"Nothing queued to print.",! G ENDX
14 .W !!!,"There are entries in the Orderable Item file with leading numerics.",!
15 .S DIR("?")=" ",DIR("?",1)="There are some entries in the Orderable Item file with leading numerics.",DIR("?",2)="Enter Yes to print the report for those drugs.",DIR("?",3)=" "
16 I $G(PSSNUMBX),$G(Y)=1 S PSSSRT="N" G DEV
17 K PSSNUMB,PSSNUMBX
18ASKA K PSSBEG,PSSEND
19 W !!,"To see items beginning with the letter 'A', enter 'A', or whichever letter you",!,"wish to see. To see items in a range, for example items starting with the",!,"letters 'G', 'H', 'I' and 'J', enter in the format 'G-J'.",!
20 S DIR("?",1)=" ",DIR("?",2)="Enter either 1 letter, 'A', 'B', etc., to see items beginning with that letter,",DIR("?",3)="or to see a range of items enter in the format 'A-C', 'G-M', 'S-Z', etc.",DIR("?",4)=" ",DIR("?")=" "
21 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
22 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
23 I X["-" S PSSBEG=$P(X,"-"),PSSEND=$P(X,"-",2) I $A(PSSEND)<$A(PSSBEG) W !!,"Invalid response.",! G ASKA
24 I X'["-" S PSSBEG=X,PSSEND=X
25 S PSSSRT="X"
26DEV I PSSSRT="X" W !!,"Report will be for items starting with the letter "_$G(PSSBEG)_",",!,"and ending with items starting with the letter "_$G(PSSEND)_".",!
27 I PSSSRT="N" W !!,"This report will be for items with leading numerics.",!
28 I PSSSRT="A" W !!,"This report will be for all items.",!
29 K DIR S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="Y" D ^DIR K DIR I Y'=1 W ! G EN
30 ;W $C(7),!!?3,"This report is designed for 132 column format!",!
31 W ! K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! G ENDX
32 I $D(IO("Q")) S ZTRTN="START^PSSOIDOS",ZTDESC="Orderable Item/Dosages Review Report",ZTSAVE("PSSHOW")="",ZTSAVE("PSSBEG")="",ZTSAVE("PSSEND")="",ZTSAVE("PSSSRT")="" D ^%ZTLOAD K %ZIS W !,"Report queued to print.",! G ENDX
33START ;
34 U IO
35 I '$G(DT) S DT=$$DT^XLFDT
36 S X1=DT,X2=-365 D C^%DTC S PSSYEAR=$G(X) K X,X1,X2
37 S PSSOUT=0,PSSDV=$S($E(IOST)="C":"C",1:"P"),PSSCT=1
38 K PSSLINE,PSSIEND S $P(PSSLINE,"-",78)=""
39 D HD
40 G:PSSSRT="N" PASS
41 S PSSX=$A(PSSBEG)-1
42 S PSSNAME=$C(PSSX)_"zzzz"
43PASS ;
44 I $G(PSSSRT)="N" S (PSSNAME,PSSEND)=""
45 I $G(PSSSRT)="A" S (PSSNAME,PSSEND)=""
46 F S PSSNAME=$O(^PS(50.7,"ADF",PSSNAME)) Q:$S(PSSSRT="N"&('PSSNAME):1,PSSSRT="X"&(PSSNAME](PSSEND_"zzzz")):1,1:0)!(PSSNAME=""&(PSSSRT="X"))!(PSSSRT="A"&(PSSNAME=""))!($G(PSSOUT)) D
47 .F PSSIEND=0:0 S PSSIEND=$O(^PS(50.7,"ADF",PSSNAME,PSSIEND)) Q:'PSSIEND!($G(PSSOUT)) F PSSIEN=0:0 S PSSIEN=$O(^PS(50.7,"ADF",PSSNAME,PSSIEND,PSSIEN)) Q:'PSSIEN!($G(PSSOUT)) D
48 ..Q:'$D(^PS(50.7,PSSIEN,0))
49 ..Q:$P($G(^PS(50.7,PSSIEN,0)),"^",3)
50 ..I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
51 ..K PSSINA,PSSNF,PSSINAD,PSSUNIT,PSSAPU S PSSINA=$P($G(^PS(50.7,PSSIEN,0)),"^",4)
52 ..I $G(PSSINA),$G(PSSYEAR),$G(PSSINA)<$G(PSSYEAR) Q
53 ..I $G(PSSINA) S PSSINAD=$E(PSSINA,4,5)_"/"_$E(PSSINA,6,7)_"/"_$E(PSSINA,2,3)
54 ..S PSSLEN=$P($G(^PS(50.7,PSSIEN,0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^PS(50.7,PSSIEN,0)),"^",2),0)),"^")
55 ..W !!,$G(PSSLEN)
56 ..I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
57 ..I $G(PSSINA) D
58 ...I $L(PSSLEN)>62 W !,?64,$G(PSSINAD) Q
59 ...W ?64,$G(PSSINAD)
60 ..I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
61 ..K PSSINP,PSSINPZ D DOSE^PSSORUTZ(.PSSINP,PSSIEN,"U") D
62 ...I '$O(PSSINP(0)) Q
63 ...W !?2,"Inpatient Dosages:"
64 ...F PSSINPX=0:0 S PSSINPX=$O(PSSINP(PSSINPX)) Q:'PSSINPX!($G(PSSOUT)) D
65 ....I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
66 ....S PSSLZ=$P($G(PSSINP(PSSINPX)),"^",5) W !?4,PSSLZ
67 ....I $L(PSSLZ)>32 W !
68 ....W ?38,$P($G(PSSINP("DD",+$P($G(PSSINP(PSSINPX)),"^",6))),"^")
69 ..Q:$G(PSSOUT)
70 ..K PSSOUP,PSSOUPZ,PSSLZZZ D DOSE^PSSORUTZ(.PSSOUP,PSSIEN,"O") D
71 ...I '$O(PSSOUP(0)) Q
72 ...W !?2,"Outpatient Dosages:"
73 ...F PSSOUPX=0:0 S PSSOUPX=$O(PSSOUP(PSSOUPX)) Q:'PSSOUPX!($G(PSSOUT)) D
74 ....I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
75 ....S PSSLZ=$P($G(PSSOUP(PSSOUPX)),"^",5) W !?4,PSSLZ
76 ....K PSSLZZZ I $P($G(PSSOUP(PSSOUPX)),"^")'="" S PSSLZZZ="("_$P($G(PSSOUP(PSSOUPX)),"^",3)_" "_$P($G(PSSOUP(PSSOUPX)),"^",4)_")"
77 ....I $S($L(PSSLZ)>10&($G(PSSLZZZ)'=""):1,$L(PSSLZ)>32:1,1:0) W !
78 ....I $G(PSSLZZZ)'="" W ?16,$G(PSSLZZZ) I $L(PSSLZZZ)>20 W !
79 ....W ?38,$P($G(PSSOUP("DD",+$P($G(PSSOUP(PSSOUPX)),"^",6))),"^")
80END ;
81 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
82 I $G(PSSDV)="C" W !
83 E W @IOF
84ENDX K PSSOUP,PSSOUPX,PSSINP,PSSINPX,PSSOUPZ,PSSINPZ,PSSLZ,PSSLZZZ
85 K PSSNODE,PSSLEN,PSSIEND,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="@"
86 Q
87HD ;
88 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
89 W @IOF W !,$S(PSSSRT="N":"Dosage report for Orderable Items with leading numerics",PSSSRT="A":"Dosage report for all Orderable Items",1:"Dosage report for Orderable Items from "_PSSBEG_" through "_PSSEND),?64,"PAGE: "_$G(PSSCT) S PSSCT=PSSCT+1
90 W !,PSSLINE
91 Q
92SETD ;
93 N PSSVA,PSSVA1,PSSVB,PSSVB1,PSSDASH,PSSNDFS,PSSDASH2,PSSDASH3,PSSDASH4,PSSDASH5 K PSSCALC
94 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
95 S PSSVA=$P(PSSUNIT,"/"),PSSVB=$P(PSSUNIT,"/",2),PSSVA1=+$G(PSSVA),PSSVB1=+$G(PSSVB)
96 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))
97 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))
98 Q
99OUT ;
100 K PSSDFOI,PSSDFOIN,PSSDF,PSSDZZ
101 Q:$G(PSSE)'["O"
102 S PSSDFOI=$P($G(^PSDRUG(PSSIEN,2)),"^") Q:'PSSDFOI
103 S PSSDF=$P($G(^PS(50.7,+PSSDFOI,0)),"^",2)
104 S PSSDFOIN=$P($G(^PS(50.606,+$G(PSSDF),0)),"^")
105 Q:'PSSDF
106 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)),"^")
107 I $G(PSSDZ)="" S PSSDZ=$G(PSSDFOIN)
108 I $G(PSSC) D PARN
109 W ?94,$G(PSSC)_" "_$S($G(PSSDZN)'="":$G(PSSDZN),1:$G(PSSDZ))
110 K PSSDFOI,PSSDF,PSSDZ,PSSDZZ,PSSDZN,PSSDZNX,PSSDFOIN
111 Q
112PARN ;
113 K PSSDZN,PSSDZNX
114 Q:$G(PSSDZ)=""
115 Q:$L(PSSDZ)'>3
116 S PSSDZNX=$E(PSSDZ,($L(PSSDZ)-2),$L(PSSDZ))
117 I $G(PSSDZNX)="(S)"!($G(PSSDZNX)="(s)") D
118 .I $G(PSSC)'>1 S PSSDZN=$E(PSSDZ,1,($L(PSSDZ)-3))
119 .I $G(PSSC)>1 S PSSDZN=$E(PSSDZ,1,($L(PSSDZ)-3))_$E(PSSDZNX,2)
120 Q
Note: See TracBrowser for help on using the repository browser.