PSSNFI ;BIR/WRT-Print report of drugs with no match to NDF (all or only OP) ;12/02/99
;;1.0;PHARMACY DATA MANAGEMENT;**29,38**;9/30/97
;
;
W !!,"This report shows the dispense drugs and orderable items",!,"with the formulary information associated with them."
EN ;
K PSSHOW,PSSBEG,PSSEND,PSSNUMBX,PSSSRT
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
.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."
S PSSHOW=Y I PSSHOW="A" S PSSBEG="A",PSSEND="Z" S PSSSRT="A" G TASK
;
S PSSNUMB="" F S PSSNUMB=$O(^PSDRUG("B",PSSNUMB)) Q:'PSSNUMB!($G(PSSNUMBX)) S PSSNUMBX=1
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
.W !!!,"There are drugs in the Drug file with leading numerics.",!
.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)=" "
I $G(PSSNUMBX),$G(Y)=1 S PSSSRT="N" G TASK
K PSSNUMB,PSSNUMBX
ASKA K PSSBEG,PSSEND
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'.",!
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("?")=" "
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
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
I X["-" S PSSBEG=$P(X,"-"),PSSEND=$P(X,"-",2) I $A(PSSEND)<$A(PSSBEG) W !!,"Invalid response.",! G ASKA
I X'["-" S PSSBEG=X,PSSEND=X
S PSSSRT="X"
TASK 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."
W !,"If you answer ""no"", you will print only formulary designations."
W $C(7),!!,"This report requires 132 columns.",!
W !,"You may queue the report to print, if you wish.",!
ASK 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"
D ^DIR K DIR D OUT I PSSFLAG=1 K PSSTX,PSSFLAG,X Q
I "Yy"[X S PSSTX=1
;
DEV 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)_".",!
I PSSSRT="N" W !!,"This report will be for drugs with leading numerics.",!
I PSSSRT="A" W !!,"This report will be for all drugs.",!
K DIR S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="Y" D ^DIR K DIR I Y'=1 W ! G EN
;
DVC K %ZIS,POP,IOP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! G DONE
QUEUE 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
START ;
U IO
S PSSOUT=0,PSSDV=$S($E(IOST)="C":"C",1:"P")
S PSSPGCT=0,PSSPGLNG=IOSL-5,PSSPRT=0,PSSPGCT=1
D TITLE
S:PSSSRT'="N" PSSX=$A(PSSBEG)-1,PSSLCL=$C(PSSX)_"zzzz"
I $G(PSSSRT)="N"!($G(PSSSRT)="A") S (PSSLCL,PSSEND)=""
;
LOOP 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
.F PSSB=0:0 S PSSB=$O(^PSDRUG("B",PSSLCL,PSSB)) Q:'PSSB D RSET,DATE
G END
DATE I '$G(^PSDRUG(PSSB,"I"))!(+$G(^("I"))>DT) D NOTHG,POI,DTEXT,ITEXT
Q
RSET S LOC="",VISN="",NAT="",OIFS="",DRTX="",DEA="",TXT="",APU="",OINM=""
Q
DTEXT 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
.I PSF=1 D PDTEXT1 S PSF=0
.D:$Y>PSSPGLNG TITLE Q:$G(PSSOUT)
.D PDTEXT
Q
DTX I $D(^PSDRUG(PSSB,9,0)),$O(^PSDRUG(PSSB,9,0)) S TXT="I"
Q
PDTEXT1 W !,"Dispense Drug text:"
I ($Y+5)>IOSL D TITLE Q:$G(PSSOUT)
Q
PDTEXT S TXNFO=$P(^PS(51.7,POINT,2,1,0),"^") S:$L(TXNFO)>70 TXNFO=$E(TXNFO,1,70)_"..." W !?5,TXNFO
I ($Y+5)>IOSL D TITLE Q:$G(PSSOUT)
Q
NOTHG 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
Q
POI 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
Q
POITXT S OITM=$P($G(^PSDRUG(PSSB,2)),"^") I OITM I $O(^PS(50.7,OITM,1,0)) S TXT="I"
Q
OI W !?3,"Orderable Item: "_OINM_" "_OIFS
I ($Y+5)>IOSL D TITLE Q:$G(PSSOUT)
Q
POOI W !,"Orderable Item text:"
I ($Y+5)>IOSL D TITLE Q:$G(PSSOUT)
Q
PPOITXT S INFO=$P(^PS(51.7,POINTR,2,1,0),"^") S:$L(INFO)>70 INFO=$E(INFO,1,70)_"..." W !?5,INFO
I ($Y+5)>IOSL D TITLE Q:$G(PSSOUT)
Q
MCLS I $D(^PSDRUG(PSSB,"ND")) S PSSMC=^PSDRUG(PSSB,"ND") I $P(PSSMC,"^",2)']"" S NAT=$P(PSSMC,"^",11) S:NAT'=1 NAT="N"
Q
REPRT D:$Y>PSSPGLNG TITLE Q:$G(PSSOUT) W !!,PSSLCL,?43,LOC,?51,VISN,?58,NAT,?69,DEA,?83,APU,?93,TXT
S PSSPRT=1
Q
OUT I $D(DTOUT),DTOUT=1 S PSSFLAG=1
I X="^" S PSSFLAG=1
Q
ITEXT 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
.I PSF=1 D POOI S PSF=0
.D:$Y>PSSPGLNG TITLE Q:$G(PSSOUT)
.D PPOITXT
Q
TITLE ;
I $G(PSSDV)="C",$G(PSSPGCT)'=1 W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSSOUT=1 Q
;
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),!
S Y=DT X ^DD("DD") W !,"Date printed: ",Y,?116,"Page: ",PSSPGCT,!
W !,"Generic Name",?43,"Local",?51,"Visn",?58,"National",?69,"Restriction",?83,"Appl",?93,"Drug",!
W ?83,"Pkg",?93,"Text",!,?83,"Use",!
F MJT=1:1:132 W "-"
S PSSPGCT=PSSPGCT+1
Q
END ;
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
I $G(PSSDV)="C" W !
E W @IOF
DONE ;
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")
K PSSSRT,PSSSTR,PSSDV,PSSX,PSSOUT,PSSHOW,PSSBEG,PSSEND D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSNFI 7323 printed Dec 13, 2024@02:33:15 Page 2
PSSNFI ;BIR/WRT-Print report of drugs with no match to NDF (all or only OP) ;12/02/99
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**29,38**;9/30/97
+2 ;
+3 ;
+4 WRITE !!,"This report shows the dispense drugs and orderable items",!,"with the formulary information associated with them."
EN ;
+1 KILL PSSHOW,PSSBEG,PSSEND,PSSNUMBX,PSSSRT
+2 KILL DIR
SET DIR(0)="S^A:ALL;S:SELECT A RANGE"
SET DIR("B")="S"
SET DIR("A")="Print Report for (A)ll or (S)elect a Range"
Begin DoDot:1
+3 SET DIR("?")=" "
SET DIR("?",1)="Enter 'A' to run report for all dispense drugs. Enter 'S' to select a range"
SET DIR("?",2)="(alphabetically) of dispense drugs to print."
End DoDot:1
DO ^DIR
KILL DIR
IF Y["^"!($DATA(DTOUT))!($DATA(DUOUT))
WRITE !!,"Nothing queued to print.",!
GOTO DONE
+4 SET PSSHOW=Y
IF PSSHOW="A"
SET PSSBEG="A"
SET PSSEND="Z"
SET PSSSRT="A"
GOTO TASK
+5 ;
+6 SET PSSNUMB=""
FOR
SET PSSNUMB=$ORDER(^PSDRUG("B",PSSNUMB))
if 'PSSNUMB!($GET(PSSNUMBX))
QUIT
SET PSSNUMBX=1
+7 IF $GET(PSSNUMBX)
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Print report for drugs with leading numerics"
SET DIR("B")="N"
Begin DoDot:1
+8 WRITE !!!,"There are drugs in the Drug file with leading numerics.",!
+9 SET DIR("?")=" "
SET DIR("?",1)="There are some entries in the drug file with leading numerics."
SET DIR("?",2)="Enter Yes to print the report for those drugs."
SET DIR("?",3)=" "
End DoDot:1
DO ^DIR
KILL DIR
IF Y["^"!($DATA(DUOUT))!($DATA(DTOUT))
WRITE !!,"Nothing queued to print.",!
GOTO DONE
+10 IF $GET(PSSNUMBX)
IF $GET(Y)=1
SET PSSSRT="N"
GOTO TASK
+11 KILL PSSNUMB,PSSNUMBX
ASKA KILL PSSBEG,PSSEND
+1 WRITE !!,"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'.",!
+2 SET DIR("?",1)=" "
SET DIR("?",2)="Enter either 1 letter, 'A', 'B', etc., to see drugs beginning with that letter,"
SET DIR("?",3)="or to see a range of drugs enter in the format 'A-C', 'G-M', 'S-Z', etc."
SET DIR("?",4)=" "
SET DIR("?")=" "
+3 SET DIR("A")="Select a Range"
SET DIR(0)="F^1:3"
DO ^DIR
KILL DIR
IF Y["^"!($DATA(DTOUT))!($DATA(DUOUT))
WRITE !!,"Nothing queued to print.",!
GOTO DONE
+4 SET X=Y
IF X'?1U&(X'?1U1"-"1U)&(X'?1L)&(X'?1L1"-"1L)
WRITE !!,"Invalid response, enter a letter, 'A', 'B', etc., or a range, 'C-F', 'M-R', etc.",!
GOTO ASKA
+5 IF X["-"
SET PSSBEG=$PIECE(X,"-")
SET PSSEND=$PIECE(X,"-",2)
IF $ASCII(PSSEND)<$ASCII(PSSBEG)
WRITE !!,"Invalid response.",!
GOTO ASKA
+6 IF X'["-"
SET PSSBEG=X
SET PSSEND=X
+7 SET PSSSRT="X"
TASK WRITE !!,"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."
+1 WRITE !,"If you answer ""no"", you will print only formulary designations."
+2 WRITE $CHAR(7),!!,"This report requires 132 columns.",!
+3 WRITE !,"You may queue the report to print, if you wish.",!
ASK SET PSSTX=0
SET PSSFLAG=0
KILL DIR
SET DIR("A")="Include drug text information "
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("?")="Enter 'Yes' to display the drug text information associated with the Pharmacy Orderable Item and Dispense Drug"
+1 DO ^DIR
KILL DIR
DO OUT
IF PSSFLAG=1
KILL PSSTX,PSSFLAG,X
QUIT
+2 IF "Yy"[X
SET PSSTX=1
+3 ;
DEV IF PSSSRT="X"
WRITE !!,"Report will be for drugs starting with the letter "_$GET(PSSBEG)_",",!,"and ending with drugs starting with the letter "_$GET(PSSEND)_".",!
+1 IF PSSSRT="N"
WRITE !!,"This report will be for drugs with leading numerics.",!
+2 IF PSSSRT="A"
WRITE !!,"This report will be for all drugs.",!
+3 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Is this correct"
SET DIR("B")="Y"
DO ^DIR
KILL DIR
IF Y'=1
WRITE !
GOTO EN
+4 ;
DVC KILL %ZIS,POP,IOP
SET %ZIS="QM"
DO ^%ZIS
IF $GET(POP)
WRITE !!,"Nothing queued to print.",!
GOTO DONE
QUEUE IF $DATA(IO("Q"))
SET ZTRTN="START^PSSNFI"
SET ZTDESC="Formulary Information Report"
SET ZTSAVE("PSSTX")=""
SET ZTSAVE("PSSHOW")=""
SET ZTSAVE("PSSBEG")=""
SET ZTSAVE("PSSEND")=""
SET ZTSAVE("PSSSRT")=""
DO ^%ZTLOAD
KILL %ZSI
WRITE !,"Report queeud to print.",!
GOTO DONE
START ;
+1 USE IO
+2 SET PSSOUT=0
SET PSSDV=$SELECT($EXTRACT(IOST)="C":"C",1:"P")
+3 SET PSSPGCT=0
SET PSSPGLNG=IOSL-5
SET PSSPRT=0
SET PSSPGCT=1
+4 DO TITLE
+5 if PSSSRT'="N"
SET PSSX=$ASCII(PSSBEG)-1
SET PSSLCL=$CHAR(PSSX)_"zzzz"
+6 IF $GET(PSSSRT)="N"!($GET(PSSSRT)="A")
SET (PSSLCL,PSSEND)=""
+7 ;
LOOP FOR
SET PSSLCL=$ORDER(^PSDRUG("B",PSSLCL))
if $SELECT(PSSSRT="N"&('PSSLCL)
QUIT
Begin DoDot:1
+1 FOR PSSB=0:0
SET PSSB=$ORDER(^PSDRUG("B",PSSLCL,PSSB))
if 'PSSB
QUIT
DO RSET
DO DATE
End DoDot:1
+2 GOTO END
DATE IF '$GET(^PSDRUG(PSSB,"I"))!(+$GET(^("I"))>DT)
DO NOTHG
DO POI
DO DTEXT
DO ITEXT
+1 QUIT
RSET SET LOC=""
SET VISN=""
SET NAT=""
SET OIFS=""
SET DRTX=""
SET DEA=""
SET TXT=""
SET APU=""
SET OINM=""
+1 QUIT
DTEXT IF $DATA(^PSDRUG(PSSB,9,0))
SET PSF=1
FOR TD=0:0
SET TD=$ORDER(^PSDRUG(PSSB,9,TD))
if 'TD
QUIT
SET POINT=$PIECE(^PSDRUG(PSSB,9,TD,0),"^")
SET PSSDAY=$PIECE($GET(^PS(51.7,POINT,0)),"^",2)
IF 'PSSDAY!(PSSDAY'<DT)
IF PSSTX=1
Begin DoDot:1
+1 IF PSF=1
DO PDTEXT1
SET PSF=0
+2 if $Y>PSSPGLNG
DO TITLE
if $GET(PSSOUT)
QUIT
+3 DO PDTEXT
End DoDot:1
+4 QUIT
DTX IF $DATA(^PSDRUG(PSSB,9,0))
IF $ORDER(^PSDRUG(PSSB,9,0))
SET TXT="I"
+1 QUIT
PDTEXT1 WRITE !,"Dispense Drug text:"
+1 IF ($Y+5)>IOSL
DO TITLE
if $GET(PSSOUT)
QUIT
+2 QUIT
PDTEXT SET TXNFO=$PIECE(^PS(51.7,POINT,2,1,0),"^")
if $LENGTH(TXNFO)>70
SET TXNFO=$EXTRACT(TXNFO,1,70)_"..."
WRITE !?5,TXNFO
+1 IF ($Y+5)>IOSL
DO TITLE
if $GET(PSSOUT)
QUIT
+2 QUIT
NOTHG SET ZERO=^PSDRUG(PSSB,0)
SET LOC=$PIECE(ZERO,"^",9)
SET VISN=$PIECE(ZERO,"^",11)
SET DEA=$PIECE(ZERO,"^",3)
if LOC=1
SET LOC="N"
if VISN=1
SET VISN="N"
if DEA["R"
SET DEA="R"
if DEA'="R"
SET DEA=""
SET APU=$PIECE($GET(^PSDRUG(PSSB,2)),"^",3)
DO MCLS
DO DTX
DO POITXT
DO REPRT
+1 QUIT
POI SET PT1=$PIECE($GET(^PSDRUG(PSSB,2)),"^")
IF PT1
SET DFPTR=$PIECE(^PS(50.7,PT1,0),"^",2)
SET DF=$PIECE($GET(^PS(50.606,DFPTR,0)),"^")
SET OINM=$PIECE(^PS(50.7,PT1,0),"^")_" "_DF
SET OIFS=$PIECE(^PS(50.7,PT1,0),"^",12)
if OIFS=1
SET OIFS="(N/F)"
DO OI
+1 QUIT
POITXT SET OITM=$PIECE($GET(^PSDRUG(PSSB,2)),"^")
IF OITM
IF $ORDER(^PS(50.7,OITM,1,0))
SET TXT="I"
+1 QUIT
OI WRITE !?3,"Orderable Item: "_OINM_" "_OIFS
+1 IF ($Y+5)>IOSL
DO TITLE
if $GET(PSSOUT)
QUIT
+2 QUIT
POOI WRITE !,"Orderable Item text:"
+1 IF ($Y+5)>IOSL
DO TITLE
if $GET(PSSOUT)
QUIT
+2 QUIT
PPOITXT SET INFO=$PIECE(^PS(51.7,POINTR,2,1,0),"^")
if $LENGTH(INFO)>70
SET INFO=$EXTRACT(INFO,1,70)_"..."
WRITE !?5,INFO
+1 IF ($Y+5)>IOSL
DO TITLE
if $GET(PSSOUT)
QUIT
+2 QUIT
MCLS IF $DATA(^PSDRUG(PSSB,"ND"))
SET PSSMC=^PSDRUG(PSSB,"ND")
IF $PIECE(PSSMC,"^",2)']""
SET NAT=$PIECE(PSSMC,"^",11)
if NAT'=1
SET NAT="N"
+1 QUIT
REPRT if $Y>PSSPGLNG
DO TITLE
if $GET(PSSOUT)
QUIT
WRITE !!,PSSLCL,?43,LOC,?51,VISN,?58,NAT,?69,DEA,?83,APU,?93,TXT
+1 SET PSSPRT=1
+2 QUIT
OUT IF $DATA(DTOUT)
IF DTOUT=1
SET PSSFLAG=1
+1 IF X="^"
SET PSSFLAG=1
+2 QUIT
ITEXT IF PT1
IF $DATA(^PS(50.7,PT1,1,0))
SET PSF=1
FOR TDD=0:0
SET TDD=$ORDER(^PS(50.7,PT1,1,TDD))
if 'TDD
QUIT
SET POINTR=$PIECE(^PS(50.7,PT1,1,TDD,0),"^")
SET TXT="I"
SET PSSDAY1=$PIECE($GET(^PS(51.7,POINTR,0)),"^",2)
IF 'PSSDAY1!(PSSDAY1'<DT)
IF PSSTX=1
Begin DoDot:1
+1 IF PSF=1
DO POOI
SET PSF=0
+2 if $Y>PSSPGLNG
DO TITLE
if $GET(PSSOUT)
QUIT
+3 DO PPOITXT
End DoDot:1
+4 QUIT
TITLE ;
+1 IF $GET(PSSDV)="C"
IF $GET(PSSPGCT)'=1
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET PSSOUT=1
QUIT
+2 ;
+3 WRITE @IOF
WRITE !,?40,$SELECT(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),!
+4 SET Y=DT
XECUTE ^DD("DD")
WRITE !,"Date printed: ",Y,?116,"Page: ",PSSPGCT,!
+5 WRITE !,"Generic Name",?43,"Local",?51,"Visn",?58,"National",?69,"Restriction",?83,"Appl",?93,"Drug",!
+6 WRITE ?83,"Pkg",?93,"Text",!,?83,"Use",!
+7 FOR MJT=1:1:132
WRITE "-"
+8 SET PSSPGCT=PSSPGCT+1
+9 QUIT
END ;
+1 IF '$GET(PSSOUT)
IF $GET(PSSDV)="C"
WRITE !!,"End of Report."
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+2 IF $GET(PSSDV)="C"
WRITE !
+3 IF '$TEST
WRITE @IOF
DONE ;
+1 KILL 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")
+2 KILL PSSSRT,PSSSTR,PSSDV,PSSX,PSSOUT,PSSHOW,PSSBEG,PSSEND
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 QUIT
