PSNMCLS.m

PSNMCLS ;BIR/WRT-Print report of drugs manually classed (excluding supply items) SORT BY LOCAL GENERIC NAME ;01/12/98   5:18 PM

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

 W !!,"This report will give you an alphabetic listing, by local generic name, of the",!,"drugs from your local drug file which are ""active"" and have been assigned a",!

 W "manual VA Drug Classification through the option ""Allow Unmatched Drugs To Be",!,"Classed"". This report will exclude your supply items that have been assigned",!,"an ""XA"" class."

 W !,"You may queue the report to print, if you wish.",!

DVC K %ZIS,POP,IOP S %ZIS="QM",%ZIS("B")="",%ZIS("A")="Select Printer: " D ^%ZIS G:POP DONE W:$E(IOST)'="P" !!,"This report must be run on a printer.",!! G:$E(IOST)'="P" DVC I POP K IOP,POP,IO("Q") Q

QUEUE I $D(IO("Q")) K IO("Q") S ZTRTN="ENQ^PSNMCLS",ZTDESC="Manually Classed Drugs Report" D ^%ZTLOAD K ZTSK D ^%ZISC Q

ENQ ;ENTRY POINT WHEN QUEUED

 U IO

 S PSNPGCT=0,PSNPGLNG=IOSL-6,PSNPRT=0 D TITLE,LOOP1

DONE I $D(PSNPRT) W:PSNPRT=0 !!?23,"No Drugs Found"

 W @IOF S:$D(ZTQUEUED) ZTREQ="@" K PSNPRT,PSNB,NAME,CLSDA,WRT,CODE,MJT,PSNPGCT,PSNPGLNG,Y,IOP,POP,IO("Q") D ^%ZISC

 Q

TITLE I $D(IOF),IOF]"" W @IOF S PSNPGCT=PSNPGCT+1

 W !,?23,"MANUALLY CLASSED DRUGS REPORT",!

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

 W !,"NUMBER",?10,"LOCAL DRUG GENERIC NAME",?63,"VA DRUG CLASS",!

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

 Q

LOOP1 S NAME="" F WRT=0:0 S NAME=$O(^PSDRUG("B",NAME)) Q:NAME=""  F PSNB=0:0 S PSNB=$O(^PSDRUG("B",NAME,PSNB)) Q:'PSNB  D LOOP2

 Q

LOOP2 I '$D(^PSDRUG(PSNB,"I")),$D(^PSDRUG(PSNB,"ND")),$P(^PSDRUG(PSNB,"ND"),"^",2)']"" S CLSDA=$P(^PSDRUG(PSNB,"ND"),"^",6) I $D(^PS(50.605,CLSDA,0)) D STRIP

 Q

STRIP S CODE=$P(^PS(50.605,CLSDA,0),"^",1) I "XA"'[$E(CODE,1,2) D REPRT

 Q

REPRT D:$Y>PSNPGLNG TITLE W !!,PSNB,?10,$P(^PSDRUG(PSNB,0),"^",1),?63,$P(^PS(50.605,$P(^PSDRUG(PSNB,"ND"),"^",6),0),"^",1) S PSNPRT=1

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSNMCLS   1938     printed  Apr 09, 2024@21:22:23                                                                                                                                                                                                     Page 2

PSNMCLS   ;BIR/WRT-Print report of drugs manually classed (excluding supply items) SORT BY LOCAL GENERIC NAME ;01/12/98   5:18 PM

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

 +2        WRITE !!,"This report will give you an alphabetic listing, by local generic name, of the",!,"drugs from your local drug file which are ""active"" and have been assigned a",!

 +3        WRITE "manual VA Drug Classification through the option ""Allow Unmatched Drugs To Be",!,"Classed"". This report will exclude your supply items that have been assigned",!,"an ""XA"" class."

 +4        WRITE !,"You may queue the report to print, if you wish.",!

DVC        KILL %ZIS,POP,IOP

           SET %ZIS="QM"

           SET %ZIS("B")=""

           SET %ZIS("A")="Select Printer: "

           DO ^%ZIS

           if POP

               GOTO DONE

           if $EXTRACT(IOST)'="P"

               WRITE !!,"This report must be run on a printer.",!!

           if $EXTRACT(IOST)'="P"

               GOTO DVC

           IF POP

               KILL IOP,POP,IO("Q")

               QUIT 

QUEUE      IF $DATA(IO("Q"))

               KILL IO("Q")

               SET ZTRTN="ENQ^PSNMCLS"

               SET ZTDESC="Manually Classed Drugs Report"

               DO ^%ZTLOAD

               KILL ZTSK

               DO ^%ZISC

               QUIT 

ENQ       ;ENTRY POINT WHEN QUEUED

 +1        USE IO

 +2        SET PSNPGCT=0

           SET PSNPGLNG=IOSL-6

           SET PSNPRT=0

           DO TITLE

           DO LOOP1

DONE       IF $DATA(PSNPRT)

               if PSNPRT=0

                   WRITE !!?23,"No Drugs Found"

 +1        WRITE @IOF

           if $DATA(ZTQUEUED)

               SET ZTREQ="@"

           KILL PSNPRT,PSNB,NAME,CLSDA,WRT,CODE,MJT,PSNPGCT,PSNPGLNG,Y,IOP,POP,IO("Q")

           DO ^%ZISC

 +2        QUIT 

TITLE      IF $DATA(IOF)

               IF IOF]""

                   WRITE @IOF

                   SET PSNPGCT=PSNPGCT+1

 +1        WRITE !,?23,"MANUALLY CLASSED DRUGS REPORT",!

 +2        SET Y=DT

           XECUTE ^DD("DD")

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

 +3        WRITE !,"NUMBER",?10,"LOCAL DRUG GENERIC NAME",?63,"VA DRUG CLASS",!

 +4        FOR MJT=1:1:80

               WRITE "-"

 +5        QUIT 

LOOP1      SET NAME=""

           FOR WRT=0:0

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

               if NAME=""

                   QUIT 

               FOR PSNB=0:0

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

                   if 'PSNB

                       QUIT 

                   DO LOOP2

 +1        QUIT 

LOOP2      IF '$DATA(^PSDRUG(PSNB,"I"))

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

                   IF $PIECE(^PSDRUG(PSNB,"ND"),"^",2)']""

                       SET CLSDA=$PIECE(^PSDRUG(PSNB,"ND"),"^",6)

                       IF $DATA(^PS(50.605,CLSDA,0))

                           DO STRIP

 +1        QUIT 

STRIP      SET CODE=$PIECE(^PS(50.605,CLSDA,0),"^",1)

           IF "XA"'[$EXTRACT(CODE,1,2)

               DO REPRT

 +1        QUIT 

REPRT      if $Y>PSNPGLNG

               DO TITLE

           WRITE !!,PSNB,?10,$PIECE(^PSDRUG(PSNB,0),"^",1),?63,$PIECE(^PS(50.605,$PIECE(^PSDRUG(PSNB,"ND"),"^",6),0),"^",1)

           SET PSNPRT=1

 +1        QUIT