PSNGPN.m

PSNGPN ;BIR/SJA-Local Drug/VA Print Name Report ; 01/11/01 10:00

 ;;4.0; NATIONAL DRUG FILE;**48**; 30 Oct 98

 ;

 ; Reference to ^PSDRUG supported by IA# 221

 ;

 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."

EN K PSNHOW,PSNBEG,PSNEND,PSNUMBX,PSNSRT

 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

 .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."

 S PSNHOW=Y I PSNHOW="A" S PSNBEG="A",PSNEND="Z" S PSNSRT="A" G DEV

 ;

 S PSNUMB="" F  S PSNUMB=$O(^PSDRUG("B",PSNUMB)) Q:'PSNUMB!($G(PSNUMBX))  S PSNUMBX=1

 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

 .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(PSNUMBX),$G(Y)=1 S PSNSRT="N" G DEV

 K PSNUMB,PSNUMBX

ASKA K PSNBEG,PSNEND

 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 PSNBEG=$P(X,"-"),PSNEND=$P(X,"-",2) I $A(PSNEND)<$A(PSNBEG) W !!,"Invalid response.",! G ASKA

 I X'["-" S PSNBEG=X,PSNEND=X

 S PSNSRT="X"

DEV 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)_".",!

 I PSNSRT="N" W !!,"This report will be for drugs with leading numerics.",!

 I PSNSRT="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^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

START ;

 U IO

 S PSNOUT=0,PSNDV=$S($E(IOST)="C":"C",1:"P")

 S PSNPGCT=0,PSNPGLNG=IOSL-5,PSNPGCT=1 D TITLE

 S:PSNSRT'="N" PSNX=$A(PSNBEG)-1,PSNLCL=$C(PSNX)_"zzzz"

 I $G(PSNSRT)="N"!($G(PSNSRT)="A") S (PSNLCL,PSNEND)=""

 ;

LOOP 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

 .F PSNB=0:0 S PSNB=$O(^PSDRUG("B",PSNLCL,PSNB)) Q:'PSNB  D CHECK

 G END

CHECK I '$G(^PSDRUG(PSNB,"I"))!(+$G(^("I"))>DT),$D(^PSDRUG(PSNB,"ND")) S PSNMC=$G(^PSDRUG(PSNB,"ND")) D

 .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

 Q

TITLE I $G(PSNDV)="C",$G(PSNPGCT)'=1 W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSNOUT=1 Q

 S PSNAM="Local Drug/VA Print Name Report"

 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)

 W @IOF W !,?25,PSNAM,!,?(80-$L(PSNAM1)\2),PSNAM1,!

 S Y=DT X ^DD("DD") W !,"Date printed: ",Y,?69,"Page: ",PSNPGCT,!

 W !,"Generic Name",?43,"VA Print Name",!

 F MJT=1:1:79 W "-"

 S PSNPGCT=PSNPGCT+1 Q

 ;

END 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

 I $G(PSNDV)="C" W !

 E  W @IOF

 ;

DONE 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

 Q

PSNGPN    ;BIR/SJA-Local Drug/VA Print Name Report ; 01/11/01 10:00

 +1       ;;4.0; NATIONAL DRUG FILE;**48**; 30 Oct 98

 +2       ;

 +3       ; Reference to ^PSDRUG supported by IA# 221

 +4       ;

 +5        WRITE !!," This report shows a list of the active drugs in local DRUG file where the",!," GENERIC NAME does not match the VA PRINT NAME."

EN         KILL PSNHOW,PSNBEG,PSNEND,PSNUMBX,PSNSRT

 +1        KILL DIR

           SET DIR(0)="S^A:ALL;S:SELECT A RANGE"

           SET DIR("B")="S"

           SET DIR("A")="Print Report for (A)ll Drugs or (S)elect a Range of Drugs"

           Begin DoDot:1

 +2            SET DIR("?")=" "

               SET DIR("?",1)="Enter 'A' to run report for all local drugs. Enter 'S' to select a range"

               SET DIR("?",2)="(alphabetically) of local drugs to print."

           End DoDot:1

           DO ^DIR

           KILL DIR

           IF Y["^"!($DATA(DTOUT))!($DATA(DUOUT))

               WRITE !!,"Nothing queued to print.",!

               GOTO DONE

 +3        SET PSNHOW=Y

           IF PSNHOW="A"

               SET PSNBEG="A"

               SET PSNEND="Z"

               SET PSNSRT="A"

               GOTO DEV

 +4       ;

 +5        SET PSNUMB=""

           FOR 

               SET PSNUMB=$ORDER(^PSDRUG("B",PSNUMB))

               IF 'PSNUMB!($GET(PSNUMBX))

                   QUIT 

               SET PSNUMBX=1

 +6        IF $GET(PSNUMBX)

               KILL DIR

               SET DIR(0)="Y"

               SET DIR("A")="Print report for drugs with leading numerics"

               SET DIR("B")="N"

               Begin DoDot:1

 +7                WRITE !!!,"There are drugs in the Drug file with leading numerics.",!

 +8                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

 +9        IF $GET(PSNUMBX)

               IF $GET(Y)=1

                   SET PSNSRT="N"

                   GOTO DEV

 +10       KILL PSNUMB,PSNUMBX

ASKA       KILL PSNBEG,PSNEND

 +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 PSNBEG=$PIECE(X,"-")

               SET PSNEND=$PIECE(X,"-",2)

               IF $ASCII(PSNEND)<$ASCII(PSNBEG)

                   WRITE !!,"Invalid response.",!

                   GOTO ASKA

 +6        IF X'["-"

               SET PSNBEG=X

               SET PSNEND=X

 +7        SET PSNSRT="X"

DEV        IF PSNSRT="X"

               WRITE !!,"This report will include drugs starting with the letter "_$GET(PSNBEG)_",",!,"and ending with drugs starting with the letter "_$GET(PSNEND)_".",!

 +1        IF PSNSRT="N"

               WRITE !!,"This report will be for drugs with leading numerics.",!

 +2        IF PSNSRT="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^PSNGPN"

               SET ZTDESC="Local Drug/VA Print Name Report"

               SET ZTSAVE("PSNHOW")=""

               SET ZTSAVE("PSNBEG")=""

               SET ZTSAVE("PSNEND")=""

               SET ZTSAVE("PSNSRT")=""

               DO ^%ZTLOAD

               KILL %ZSI

               WRITE !,"Report queued to print.",!

               GOTO DONE

START     ;

 +1        USE IO

 +2        SET PSNOUT=0

           SET PSNDV=$SELECT($EXTRACT(IOST)="C":"C",1:"P")

 +3        SET PSNPGCT=0

           SET PSNPGLNG=IOSL-5

           SET PSNPGCT=1

           DO TITLE

 +4        IF PSNSRT'="N"

               SET PSNX=$ASCII(PSNBEG)-1

               SET PSNLCL=$CHAR(PSNX)_"zzzz"

 +5        IF $GET(PSNSRT)="N"!($GET(PSNSRT)="A")

               SET (PSNLCL,PSNEND)=""

 +6       ;

LOOP       FOR 

               SET PSNLCL=$ORDER(^PSDRUG("B",PSNLCL))

               IF $SELECT(PSNSRT="N"&('PSNLCL)

                   QUIT 

               Begin DoDot:1

 +1                FOR PSNB=0:0

                       SET PSNB=$ORDER(^PSDRUG("B",PSNLCL,PSNB))

                       IF 'PSNB

                           QUIT 

                       DO CHECK

               End DoDot:1

 +2        GOTO END

CHECK      IF '$GET(^PSDRUG(PSNB,"I"))!(+$GET(^("I"))>DT)

               IF $DATA(^PSDRUG(PSNB,"ND"))

                   SET PSNMC=$GET(^PSDRUG(PSNB,"ND"))

                   Begin DoDot:1

 +1                    IF $PIECE(PSNMC,"^",2)]""

                           SET PSND3=$PIECE(PSNMC,"^",3)

                           IF PSND3

                               SET PSNVA=$PIECE($GET(^PSNDF(50.68,PSND3,1)),"^")

                               IF $PIECE(^PSDRUG(PSNB,0),"^")'=PSNVA

                                   IF $Y>PSNPGLNG

                                       DO TITLE

                                   IF $GET(PSNOUT)

                                       QUIT 

                                   WRITE !!,$PIECE(^PSDRUG(PSNB,0),"^"),?43,PSNVA

                   End DoDot:1

 +2        QUIT 

TITLE      IF $GET(PSNDV)="C"

               IF $GET(PSNPGCT)'=1

                   WRITE !

                   KILL DIR

                   SET DIR(0)="E"

                   DO ^DIR

                   KILL DIR

                   IF 'Y

                       SET PSNOUT=1

                       QUIT 

 +1        SET PSNAM="Local Drug/VA Print Name Report"

 +2        SET PSNAM1=$SELECT(PSNSRT="N":"for Drugs with Leading Numerics",PSNSRT="A":"for All Drugs",1:"for Drug Names Beginning with the letter "_PSNBEG_" through "_PSNEND)

 +3        WRITE @IOF

           WRITE !,?25,PSNAM,!,?(80-$LENGTH(PSNAM1)\2),PSNAM1,!

 +4        SET Y=DT

           XECUTE ^DD("DD")

           WRITE !,"Date printed: ",Y,?69,"Page: ",PSNPGCT,!

 +5        WRITE !,"Generic Name",?43,"VA Print Name",!

 +6        FOR MJT=1:1:79

               WRITE "-"

 +7        SET PSNPGCT=PSNPGCT+1

           QUIT 

 +8       ;

END        IF '$GET(PSNOUT)

               IF $GET(PSNDV)="C"

                   WRITE !!,"End of Report.",!

                   KILL DIR

                   SET DIR(0)="E"

                   SET DIR("A")="Press Return to continue"

                   DO ^DIR

                   KILL DIR

 +1        IF $GET(PSNDV)="C"

               WRITE !

 +2       IF '$TEST

               WRITE @IOF

 +3       ;

DONE       WRITE @IOF

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

           KILL 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")

           DO ^%ZISC

 +1        QUIT