1 | PSSDTR ;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."
|
---|
7 | EN ;
|
---|
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
|
---|
20 | ASKA 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"
|
---|
34 | TASK ;
|
---|
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
|
---|
42 | RPT W !!,"You may queue the report to print, if you wish.",!
|
---|
43 | K PSSFIRST
|
---|
44 | ;
|
---|
45 | DVC K %ZIS,POP,IOP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! G DONE
|
---|
46 | QUEUE 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
|
---|
47 | START ;
|
---|
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
|
---|
58 | DTXTRPT 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
|
---|
64 | DTNAME 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 | ;
|
---|
79 | DTEXT ;
|
---|
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 | ;
|
---|
87 | OITEXT ;
|
---|
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 | ;
|
---|
98 | NRESTR ; 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 | ;
|
---|
107 | FULL ;
|
---|
108 | I ($Y+5)>IOSL&('$G(PSSOUT)) D TITLE
|
---|
109 | Q
|
---|
110 | ;
|
---|
111 | FULL2 ;
|
---|
112 | I ($Y+6)>IOSL&('$G(PSSOUT)) D TITLE
|
---|
113 | Q
|
---|
114 | TITLE ;
|
---|
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
|
---|
133 | END ;
|
---|
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
|
---|
137 | DONE ;
|
---|
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
|
---|