PSSNFI.m

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 ---PSSNFI   7323     printed  Mar 13, 2025@21:37:49                                                                                                                                                                                                      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