source: WorldVistAEHR/trunk/r/NATIONAL_DRUG_FILE-PSN/PSNGPN.m@ 767

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1PSNGPN ;BIR/SJA-Local Drug/VA Print Name Report ; 01/11/01 10:00
2 ;;4.0; NATIONAL DRUG FILE;**48**; 30 Oct 98
3 ;
4 ; Reference to ^PSDRUG supported by IA# 221
5 ;
6 W !!," This report shows a list of the active drugs in local DRUG file where the",!," GENERIC NAME does not match the VA PRINT NAME."
7EN K PSNHOW,PSNBEG,PSNEND,PSNUMBX,PSNSRT
8 K DIR S DIR(0)="S^A:ALL;S:SELECT A RANGE",DIR("B")="S",DIR("A")="Print Report for (A)ll Drugs or (S)elect a Range of Drugs" 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 local drugs. Enter 'S' to select a range",DIR("?",2)="(alphabetically) of local drugs to print."
10 S PSNHOW=Y I PSNHOW="A" S PSNBEG="A",PSNEND="Z" S PSNSRT="A" G DEV
11 ;
12 S PSNUMB="" F S PSNUMB=$O(^PSDRUG("B",PSNUMB)) Q:'PSNUMB!($G(PSNUMBX)) S PSNUMBX=1
13 I $G(PSNUMBX) 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(PSNUMBX),$G(Y)=1 S PSNSRT="N" G DEV
17 K PSNUMB,PSNUMBX
18ASKA K PSNBEG,PSNEND
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 PSNBEG=$P(X,"-"),PSNEND=$P(X,"-",2) I $A(PSNEND)<$A(PSNBEG) W !!,"Invalid response.",! G ASKA
24 I X'["-" S PSNBEG=X,PSNEND=X
25 S PSNSRT="X"
26DEV I PSNSRT="X" W !!,"This report will include drugs starting with the letter "_$G(PSNBEG)_",",!,"and ending with drugs starting with the letter "_$G(PSNEND)_".",!
27 I PSNSRT="N" W !!,"This report will be for drugs with leading numerics.",!
28 I PSNSRT="A" W !!,"This report will be for all drugs.",!
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 ;
31DVC K %ZIS,POP,IOP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! G DONE
32QUEUE I $D(IO("Q")) S ZTRTN="START^PSNGPN",ZTDESC="Local Drug/VA Print Name Report",ZTSAVE("PSNHOW")="",ZTSAVE("PSNBEG")="",ZTSAVE("PSNEND")="",ZTSAVE("PSNSRT")="" D ^%ZTLOAD K %ZSI W !,"Report queued to print.",! G DONE
33START ;
34 U IO
35 S PSNOUT=0,PSNDV=$S($E(IOST)="C":"C",1:"P")
36 S PSNPGCT=0,PSNPGLNG=IOSL-5,PSNPGCT=1 D TITLE
37 S:PSNSRT'="N" PSNX=$A(PSNBEG)-1,PSNLCL=$C(PSNX)_"zzzz"
38 I $G(PSNSRT)="N"!($G(PSNSRT)="A") S (PSNLCL,PSNEND)=""
39 ;
40LOOP F S PSNLCL=$O(^PSDRUG("B",PSNLCL)) Q:$S(PSNSRT="N"&('PSNLCL):1,PSNSRT="X"&(PSNLCL](PSNEND_"zzzz")):1,1:0)!(PSNLCL="")!($G(PSNOUT)) D
41 .F PSNB=0:0 S PSNB=$O(^PSDRUG("B",PSNLCL,PSNB)) Q:'PSNB D CHECK
42 G END
43CHECK I '$G(^PSDRUG(PSNB,"I"))!(+$G(^("I"))>DT),$D(^PSDRUG(PSNB,"ND")) S PSNMC=$G(^PSDRUG(PSNB,"ND")) D
44 .I $P(PSNMC,"^",2)]"" S PSND3=$P(PSNMC,"^",3) I PSND3 S PSNVA=$P($G(^PSNDF(50.68,PSND3,1)),"^") I $P(^PSDRUG(PSNB,0),"^")'=PSNVA D:$Y>PSNPGLNG TITLE Q:$G(PSNOUT) W !!,$P(^PSDRUG(PSNB,0),"^"),?43,PSNVA
45 Q
46TITLE I $G(PSNDV)="C",$G(PSNPGCT)'=1 W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSNOUT=1 Q
47 S PSNAM="Local Drug/VA Print Name Report"
48 S PSNAM1=$S(PSNSRT="N":"for Drugs with Leading Numerics",PSNSRT="A":"for All Drugs",1:"for Drug Names Beginning with the letter "_PSNBEG_" through "_PSNEND)
49 W @IOF W !,?25,PSNAM,!,?(80-$L(PSNAM1)\2),PSNAM1,!
50 S Y=DT X ^DD("DD") W !,"Date printed: ",Y,?69,"Page: ",PSNPGCT,!
51 W !,"Generic Name",?43,"VA Print Name",!
52 F MJT=1:1:79 W "-"
53 S PSNPGCT=PSNPGCT+1 Q
54 ;
55END I '$G(PSNOUT),$G(PSNDV)="C" W !!,"End of Report.",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
56 I $G(PSNDV)="C" W !
57 E W @IOF
58 ;
59DONE W @IOF S:$D(ZTQUEUED) ZTREQ="@" K PSNB,PSND3,PSNVA,PSNDV,PSNLCL,PSNOUT,PSNPGCT,PSNPGLNG,PSNPRT,PSNX,PSNAM1,PSNAM,PSNFLAG,PSNMC,PSNOP,PSNUSE,PSNVCL,MJT,Y,DEA,DIR,INDT,X,IOP,POP,IO("Q") D ^%ZISC
60 Q
Note: See TracBrowser for help on using the repository browser.