source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSDTR.m@ 1259

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

initial load of WorldVistAEHR

File size: 7.5 KB
Line 
1PSSDTR ;BIR/EJW-Print Drug Text Report ;
2 ;;1.0;PHARMACY DATA MANAGEMENT;**55**;9/30/97
3 ;
4 ;Reference to $$FORMRX^PSNAPIS(DA,K,.LIST) supported by DBIA #2574
5 ;
6 W !!,"This report shows each selected drug text entry and lists all drugs",!,"and orderable items linked to it."
7EN ;
8 K PSSHOW,PSSBEG,PSSEND,PSSNUMBX,PSSSRT
9 K DIR S DIR(0)="S^A:ALL;S:SINGLE ENTRY OR RANGE",DIR("B")="S",DIR("A")="Print for (A)ll or (S)elect Single Entry or Range" D
10 .S DIR("?")=" ",DIR("?",1)="Enter 'A' for all drug text entries,",DIR("?",2)="or 'S' to select single entry or range."
11 D ^DIR K DIR I Y["^"!($D(DTOUT))!($D(DUOUT)) W !!,"Nothing queued to print.",! G DONE
12 S PSSHOW=Y I PSSHOW="A" S PSSBEG="",PSSEND="Z" S PSSSRT="A" G TASK
13 ;
14 S PSSNUMB="" F S PSSNUMB=$O(^PS(51.7,"B",PSSNUMB)) Q:'PSSNUMB!($G(PSSNUMBX)) S PSSNUMBX=1
15 I $G(PSSNUMBX) K DIR S DIR(0)="Y",DIR("A")="Print report for drug text entries with leading numerics",DIR("B")="N" D D ^DIR K DIR I Y["^"!($D(DUOUT))!($D(DTOUT)) W !!,"Nothing queued to print.",! G DONE
16 .W !!!,"There are drugs in the drug text file with leading numerics.",!
17 .S DIR("?")=" ",DIR("?",1)="There are some entries in the drug text file with leading numerics.",DIR("?",2)="Enter Yes to print the report for those entries.",DIR("?",3)=" "
18 I $G(PSSNUMBX),$G(Y)=1 S PSSSRT="N" G TASK
19 K PSSNUMB,PSSNUMBX
20ASKA K PSSBEG,PSSEND
21 W !!,"Enter a single drug text entry or to see all drug text entries beginning with"
22 W !,"the letter 'A' for example, enter 'A' or whichever letter you wish to see."
23 W !,"To see drug text entries in a range for example starting with 'H', 'I' and 'J'"
24 W !,"enter in the format 'H-J'.",!
25 S DIR("?",1)=" ",DIR("?",2)="Enter a single drug text entry or enter a letter, 'A', 'B', etc., to see",DIR("?",3)="entries beginning with that letter or to see a range of drug text entries"
26 S DIR("?",4)="enter 'A-C', 'G-M', etc.",DIR("?",5)=" ",DIR("?")=" "
27 S DIR("A")="Enter a single entry or select a range",DIR(0)="F^1:100" D ^DIR K DIR I Y["^"!($D(DTOUT))!($D(DUOUT)) W !!,"Nothing queued to print.",! G DONE
28 S PSSXX=Y
29 I PSSXX'?1U&(PSSXX'?1U1"-"1U)&(PSSXX'?1L)&(PSSXX'?1L1"-"1L) I PSSXX'="",'$D(^PS(51.7,"B",PSSXX)) D W ! G ASKA
30 . W !!,"Invalid response." W $S($L(PSSXX)>1&(PSSXX'["-"):" Entry not found.",1:" Enter a single entry, or a letter, 'A', 'B', etc., or a range.")
31 I PSSXX["-" S PSSBEG=$P(PSSXX,"-"),PSSEND=$P(PSSXX,"-",2) I $A(PSSEND)<$A(PSSBEG) W !!,"Invalid response.",! G ASKA
32 I PSSXX'["-" S PSSBEG=PSSXX,PSSEND=PSSXX
33 S PSSSRT="X"
34TASK ;
35 I PSSSRT="X",$L(PSSXX)>1,PSSXX'["-" S PSSSRT="S" ; single entry
36 I PSSSRT="X" W !!,"Report will be for drug text starting with "_$G(PSSBEG)_",",!,"and ending with drug text starting with "_$G(PSSEND)_".",!
37 I PSSSRT="N" W !!,"This report will be for drug text with leading numerics.",!
38 I PSSSRT="A" W !!,"This report will be for all drug text entries.",!
39 I PSSSRT="S" W !!,"This report will be for drug text entry: ",PSSXX,!
40 K DIR S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="Y" D ^DIR K DIR I Y'=1 W ! G EN
41 I PSSSRT="X",$L(PSSXX)>1,PSSXX'["-" S PSSSRT="S" ; single entry
42RPT W !!,"You may queue the report to print, if you wish.",!
43 K PSSFIRST
44 ;
45DVC K %ZIS,POP,IOP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! G DONE
46QUEUE I $D(IO("Q")) S ZTRTN="START^PSSDTR",ZTDESC="Drug Text File Report",ZTSAVE("PSSBEG")="",ZTSAVE("PSSEND")="",ZTSAVE("PSSSRT")="",ZTSAVE("PSSXX")="" D ^%ZTLOAD K %ZSI W !,"Report queued to print.",! G DONE
47START ;
48 U IO
49 S PSSOUT=0,PSSDV=$S($E(IOST)="C":"C",1:"P")
50 S PSSPGCT=0,PSSPGLN=IOSL-7,PSSPGCT=1
51 D TITLE
52 I PSSSRT="X" S PSSX=$A(PSSBEG)-1,PSSLCL=$C(PSSX)_"zzzz"
53 I $G(PSSSRT)="N"!($G(PSSSRT)="A") S (PSSLCL,PSSEND)=""
54 ;
55 I PSSSRT'="S" F S PSSLCL=$O(^PS(51.7,"B",PSSLCL)) Q:$S(PSSSRT="N"&('PSSLCL):1,PSSSRT="X"&(PSSLCL](PSSEND_"zzzz")):1,1:0)!(PSSLCL="")!($G(PSSOUT)) D DTXTRPT
56 I PSSSRT="S",PSSBEG'="" S PSSLCL=PSSBEG I $D(^PS(51.7,"B",PSSLCL)) D DTXTRPT
57 G END
58DTXTRPT F PSSB=0:0 S PSSB=$O(^PS(51.7,"B",PSSLCL,PSSB)) Q:'PSSB D
59 . I $G(^PS(51.7,PSSB,0))'="" D DTNAME D FULL Q:($G(PSSOUT)) D DTEXT Q:$G(PSSOUT) D OITEXT I $G(PSSOUT) Q
60 D FULL I $G(PSSOUT) Q
61 W ! F MJT=1:1:70 W "-"
62 W !
63 Q
64DTNAME D FULL Q:$G(PSSOUT) W !,"DRUG TEXT NAME: ",PSSLCL
65 D FULL2 Q:($G(PSSOUT)) S Y=+$P($G(^PS(51.7,PSSB,0)),"^",2) I Y>0 X ^DD("DD") W !,?3,"** INACTIVE DATE: ",Y," **",!
66 N PSSSYN
67 ; print synonyms, if any
68 I $O(^PS(51.7,PSSB,1,0))?1.N D FULL Q:(PSSOUT) D
69 . W !,?3,"SYNONYM(S): "
70 . S PSSSYN=0 F S PSSSYN=$O(^PS(51.7,PSSB,1,PSSSYN)) Q:'PSSSYN D FULL Q:$G(PSSOUT) W ?17,^PS(51.7,PSSB,1,PSSSYN,0),!
71 ; print drug text
72 N PSSTXT
73 D FULL2 I $G(PSSOUT) Q
74 W !!,?3,"DRUG TEXT:"
75 S PSSTXT=0 F S PSSTXT=$O(^PS(51.7,PSSB,2,PSSTXT)) Q:'PSSTXT D FULL Q:$G(PSSOUT) W !,?3,^PS(51.7,PSSB,2,PSSTXT,0)
76 D NRESTR
77 Q
78 ;
79DTEXT ;
80 D FULL2 I $G(PSSOUT) Q
81 W !!,?3,"DRUG file entries:",!,?3,"-----------------"
82 I $O(^PSDRUG("DTXT",PSSB,""))="" D FULL Q:$G(PSSOUT) W !,?3,"NONE" Q
83 S PSSDRG="" F S PSSDRG=$O(^PSDRUG("DTXT",PSSB,PSSDRG)) Q:'PSSDRG D FULL Q:($G(PSSOUT)) W !,?3,$P($G(^PSDRUG(PSSDRG,0)),"^",1) D
84 . I $P($G(^PSDRUG(PSSDRG,"I")),"^",1)'="" D FULL Q:($G(PSSOUT)) S Y=+$P($G(^PSDRUG(PSSDRG,"I")),"^",1) I Y>0 X ^DD("DD") W !,?6,"** INACTIVE DATE: ",Y," **",!
85 Q
86 ;
87OITEXT ;
88 N DFPTR
89 D FULL2 Q:$G(PSSOUT) W !!,?3,"ORDERABLE ITEM file entries: " D
90 . W !,?3,"---------------------------"
91 I $O(^PS(50.7,"DTXT",PSSB,""))="" D FULL Q:$G(PSSOUT) W !,?3,"NONE"
92 S PSSDRG="" F S PSSDRG=$O(^PS(50.7,"DTXT",PSSB,PSSDRG)) Q:'PSSDRG D FULL Q:$G(PSSOUT) W !,?3,$P($G(^PS(50.7,PSSDRG,0)),"^",1) D
93 . S DFPTR=$P(^PS(50.7,PSSDRG,0),"^",2) W " ",$P(^PS(50.606,DFPTR,0),"^",1)
94 . I $P(^PS(50.7,PSSDRG,0),"^",4)'="" D
95 . . D FULL Q:($G(PSSOUT)) S Y=+$P($G(^PS(50.7,PSSDRG,0)),"^",4) I Y>0 X ^DD("DD") W !,?6,"** INACTIVE DATE: ",Y," **",!
96 Q
97 ;
98NRESTR ; check for National Formulary Restrictions
99 N PSXGN,PSXVP,PSXDN,DONE,XX2
100 S DONE=0
101 S PSSDRG="" F S PSSDRG=$O(^PSDRUG("DTXT",PSSB,PSSDRG)) Q:'PSSDRG D Q:DONE
102 .I $D(^PSDRUG(PSSDRG,"ND")) S PSXDN=$G(^PSDRUG(PSSDRG,"ND")),PSXGN=$P(PSXDN,"^"),PSXVP=$P(PSXDN,"^",3)
103 .D FULL2 Q:$G(PSSOUT) I $G(PSXGN),$G(PSXVP) S DONE=1 W !!,?3,"NATIONAL FORMULARY RESTRICTION TEXT:" S XX2=$$FORMRX^PSNAPIS(PSXGN,PSXVP,.LIST) I $G(XX2)=1,$D(LIST) F XX2=0:0 S XX2=$O(LIST(XX2)) Q:'XX2 D FULL Q:$G(PSSOUT) W !,?3,LIST(XX2,0)
104 K LIST
105 Q
106 ;
107FULL ;
108 I ($Y+5)>IOSL&('$G(PSSOUT)) D TITLE
109 Q
110 ;
111FULL2 ;
112 I ($Y+6)>IOSL&('$G(PSSOUT)) D TITLE
113 Q
114TITLE ;
115 I $G(PSSDV)="C",$G(PSSPGCT)'=1 W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSSOUT=1 Q
116 ;
117 W @IOF D
118 . I PSSSRT="N" W !,?16,"Drug Text Report for Drug Text entries with Leading Numerics",! Q
119 . I PSSSRT="A" W !,?16,"Drug Text Report for all Drug Text entries",! Q
120 . I PSSSRT="X" W !,?16,"Drug Text Report for drug text from "_PSSBEG_" through "_PSSEND,! Q
121 . I PSSSRT="S" W !,?16,"Drug Text Report for drug text : "_PSSBEG,! Q
122 S Y=DT X ^DD("DD") W !,"Date printed: ",Y,?70,"Page: ",PSSPGCT,!
123 F MJT=1:1:79 W "="
124 W !
125 I $G(PSSFIRST)="" D
126 . W !,"PLEASE NOTE: The National Formulary Restriction Text is the original text"
127 . W !,"exported with the DRUG TEXT file (#51.7) and automatically linked to the DRUG"
128 . W !,"file (#50) entries based on the VA product match. No ORDERABLE ITEM file"
129 . W !,"(#50.7) entries were automatically linked with DRUG TEXT file (#51.7).",!
130 . S PSSFIRST=1
131 S PSSPGCT=PSSPGCT+1
132 Q
133END ;
134 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
135 I $G(PSSDV)="C" W !
136 E W @IOF
137DONE ;
138 K PSSB,PSSLCL,MJT,PSSPGCT,PSSPGLN,Y,DIR,INDT,PSSXX,X,OITM,IOP,POP,IO("Q"),DIRUT,DUOUT,DTOUT
139 K PSSSRT,PSSDRG,PSSDV,PSSX,PSSOUT,PSSHOW,PSSBEG,PSSEND D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
140 Q
Note: See TracBrowser for help on using the repository browser.