source: FOIAVistA/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSNFI.m@ 1688

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1PSSNFI ;BIR/WRT-Print report of drugs with no match to NDF (all or only OP) ;12/02/99
2 ;;1.0;PHARMACY DATA MANAGEMENT;**29,38**;9/30/97
3 ;
4 ;
5 W !!,"This report shows the dispense drugs and orderable items",!,"with the formulary information associated with them."
6EN ;
7 K PSSHOW,PSSBEG,PSSEND,PSSNUMBX,PSSSRT
8 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 DONE
9 .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."
10 S PSSHOW=Y I PSSHOW="A" S PSSBEG="A",PSSEND="Z" S PSSSRT="A" G TASK
11 ;
12 S PSSNUMB="" F S PSSNUMB=$O(^PSDRUG("B",PSSNUMB)) Q:'PSSNUMB!($G(PSSNUMBX)) S PSSNUMBX=1
13 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 DONE
14 .W !!!,"There are drugs in the Drug file with leading numerics.",!
15 .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)=" "
16 I $G(PSSNUMBX),$G(Y)=1 S PSSSRT="N" G TASK
17 K PSSNUMB,PSSNUMBX
18ASKA K PSSBEG,PSSEND
19 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'.",!
20 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("?")=" "
21 S DIR("A")="Select a Range",DIR(0)="F^1:3" D ^DIR K DIR I Y["^"!($D(DTOUT))!($D(DUOUT)) W !!,"Nothing queued to print.",! G DONE
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"
26TASK W !!,"You have the choice to print the drug text information.",!,"If you answer ""yes"" to the question, you will print all the drug text",!,"information for both dispense drug and orderable items."
27 W !,"If you answer ""no"", you will print only formulary designations."
28 W $C(7),!!,"This report requires 132 columns.",!
29 W !,"You may queue the report to print, if you wish.",!
30ASK S PSSTX=0,PSSFLAG=0 K DIR S DIR("A")="Include drug text information ",DIR(0)="Y",DIR("B")="NO",DIR("?")="Enter 'Yes' to display the drug text information associated with the Pharmacy Orderable Item and Dispense Drug"
31 D ^DIR K DIR D OUT I PSSFLAG=1 K PSSTX,PSSFLAG,X Q
32 I "Yy"[X S PSSTX=1
33 ;
34DEV 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)_".",!
35 I PSSSRT="N" W !!,"This report will be for drugs with leading numerics.",!
36 I PSSSRT="A" W !!,"This report will be for all drugs.",!
37 K DIR S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="Y" D ^DIR K DIR I Y'=1 W ! G EN
38 ;
39DVC K %ZIS,POP,IOP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! G DONE
40QUEUE I $D(IO("Q")) S ZTRTN="START^PSSNFI",ZTDESC="Formulary Information Report",ZTSAVE("PSSTX")="",ZTSAVE("PSSHOW")="",ZTSAVE("PSSBEG")="",ZTSAVE("PSSEND")="",ZTSAVE("PSSSRT")="" D ^%ZTLOAD K %ZSI W !,"Report queeud to print.",! G DONE
41START ;
42 U IO
43 S PSSOUT=0,PSSDV=$S($E(IOST)="C":"C",1:"P")
44 S PSSPGCT=0,PSSPGLNG=IOSL-5,PSSPRT=0,PSSPGCT=1
45 D TITLE
46 S:PSSSRT'="N" PSSX=$A(PSSBEG)-1,PSSLCL=$C(PSSX)_"zzzz"
47 I $G(PSSSRT)="N"!($G(PSSSRT)="A") S (PSSLCL,PSSEND)=""
48 ;
49LOOP F S PSSLCL=$O(^PSDRUG("B",PSSLCL)) Q:$S(PSSSRT="N"&('PSSLCL):1,PSSSRT="X"&(PSSLCL](PSSEND_"zzzz")):1,1:0)!(PSSLCL="")!($G(PSSOUT)) D
50 .F PSSB=0:0 S PSSB=$O(^PSDRUG("B",PSSLCL,PSSB)) Q:'PSSB D RSET,DATE
51 G END
52DATE I '$G(^PSDRUG(PSSB,"I"))!(+$G(^("I"))>DT) D NOTHG,POI,DTEXT,ITEXT
53 Q
54RSET S LOC="",VISN="",NAT="",OIFS="",DRTX="",DEA="",TXT="",APU="",OINM=""
55 Q
56DTEXT I $D(^PSDRUG(PSSB,9,0)) S PSF=1 F TD=0:0 S TD=$O(^PSDRUG(PSSB,9,TD)) Q:'TD S POINT=$P(^PSDRUG(PSSB,9,TD,0),"^"),PSSDAY=$P($G(^PS(51.7,POINT,0)),"^",2) I 'PSSDAY!(PSSDAY'<DT),PSSTX=1 D
57 .I PSF=1 D PDTEXT1 S PSF=0
58 .D:$Y>PSSPGLNG TITLE Q:$G(PSSOUT)
59 .D PDTEXT
60 Q
61DTX I $D(^PSDRUG(PSSB,9,0)),$O(^PSDRUG(PSSB,9,0)) S TXT="I"
62 Q
63PDTEXT1 W !,"Dispense Drug text:"
64 I ($Y+5)>IOSL D TITLE Q:$G(PSSOUT)
65 Q
66PDTEXT S TXNFO=$P(^PS(51.7,POINT,2,1,0),"^") S:$L(TXNFO)>70 TXNFO=$E(TXNFO,1,70)_"..." W !?5,TXNFO
67 I ($Y+5)>IOSL D TITLE Q:$G(PSSOUT)
68 Q
69NOTHG S ZERO=^PSDRUG(PSSB,0),LOC=$P(ZERO,"^",9),VISN=$P(ZERO,"^",11),DEA=$P(ZERO,"^",3) S:LOC=1 LOC="N" S:VISN=1 VISN="N" S:DEA["R" DEA="R" S:DEA'="R" DEA="" S APU=$P($G(^PSDRUG(PSSB,2)),"^",3) D MCLS,DTX,POITXT,REPRT
70 Q
71POI S PT1=$P($G(^PSDRUG(PSSB,2)),"^") I PT1 S DFPTR=$P(^PS(50.7,PT1,0),"^",2),DF=$P($G(^PS(50.606,DFPTR,0)),"^"),OINM=$P(^PS(50.7,PT1,0),"^")_" "_DF,OIFS=$P(^PS(50.7,PT1,0),"^",12) S:OIFS=1 OIFS="(N/F)" D OI
72 Q
73POITXT S OITM=$P($G(^PSDRUG(PSSB,2)),"^") I OITM I $O(^PS(50.7,OITM,1,0)) S TXT="I"
74 Q
75OI W !?3,"Orderable Item: "_OINM_" "_OIFS
76 I ($Y+5)>IOSL D TITLE Q:$G(PSSOUT)
77 Q
78POOI W !,"Orderable Item text:"
79 I ($Y+5)>IOSL D TITLE Q:$G(PSSOUT)
80 Q
81PPOITXT S INFO=$P(^PS(51.7,POINTR,2,1,0),"^") S:$L(INFO)>70 INFO=$E(INFO,1,70)_"..." W !?5,INFO
82 I ($Y+5)>IOSL D TITLE Q:$G(PSSOUT)
83 Q
84MCLS I $D(^PSDRUG(PSSB,"ND")) S PSSMC=^PSDRUG(PSSB,"ND") I $P(PSSMC,"^",2)']"" S NAT=$P(PSSMC,"^",11) S:NAT'=1 NAT="N"
85 Q
86REPRT D:$Y>PSSPGLNG TITLE Q:$G(PSSOUT) W !!,PSSLCL,?43,LOC,?51,VISN,?58,NAT,?69,DEA,?83,APU,?93,TXT
87 S PSSPRT=1
88 Q
89OUT I $D(DTOUT),DTOUT=1 S PSSFLAG=1
90 I X="^" S PSSFLAG=1
91 Q
92ITEXT I PT1,$D(^PS(50.7,PT1,1,0)) S PSF=1 F TDD=0:0 S TDD=$O(^PS(50.7,PT1,1,TDD)) Q:'TDD S POINTR=$P(^PS(50.7,PT1,1,TDD,0),"^"),TXT="I",PSSDAY1=$P($G(^PS(51.7,POINTR,0)),"^",2) I 'PSSDAY1!(PSSDAY1'<DT),PSSTX=1 D
93 .I PSF=1 D POOI S PSF=0
94 .D:$Y>PSSPGLNG TITLE Q:$G(PSSOUT)
95 .D PPOITXT
96 Q
97TITLE ;
98 I $G(PSSDV)="C",$G(PSSPGCT)'=1 W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSSOUT=1 Q
99 ;
100 W @IOF W !,?40,$S(PSSSRT="N":"Formulary Information Report for Drugs with Leading Numerics",PSSSRT="A":"Formulary Information Report for All Drugs",1:"Formulary Information Report for Drugs from "_PSSBEG_" through "_PSSEND),!
101 S Y=DT X ^DD("DD") W !,"Date printed: ",Y,?116,"Page: ",PSSPGCT,!
102 W !,"Generic Name",?43,"Local",?51,"Visn",?58,"National",?69,"Restriction",?83,"Appl",?93,"Drug",!
103 W ?83,"Pkg",?93,"Text",!,?83,"Use",!
104 F MJT=1:1:132 W "-"
105 S PSSPGCT=PSSPGCT+1
106 Q
107END ;
108 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
109 I $G(PSSDV)="C" W !
110 E W @IOF
111DONE ;
112 K PSSB,APU,DF,DFPTR,DRTX,INFO,LOC,NAT,OIFS,OINM,PT1,TD,TDD,TXNFO,TXT,VISN,ZERO,PSSDAT,PSSDAY,PSSDAY1,PSSFLAG,PSSLCL,PSSMC,PSSTX,PSSUSE,PSSVCL,PSSPRT,PSF,MJT,PSSPGCT,PSSPGLNG,Y,DEA,POINTR,DIR,INDT,X,OITM,IOP,POP,IO("Q")
113 K PSSSRT,PSSSTR,PSSDV,PSSX,PSSOUT,PSSHOW,PSSBEG,PSSEND D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
114 Q
Note: See TracBrowser for help on using the repository browser.