| 1 | PSDEA ;BIR/JPW-List Drug Name & DEA Special Handling ; 2 Aug 94
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|---|
| 3 | W !!,"This report lists Drug name, DEA Special Handling, and NDC information",!,"for all drugs marked for Controlled Substances use.",!
|
|---|
| 4 | DEV ;asks device and queueing information
|
|---|
| 5 | W !,"This report is designed for an 80 column format.",!
|
|---|
| 6 | K %ZIS,IOP,IO("Q"),POP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" G END
|
|---|
| 7 | I $D(IO("Q")) K IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK S ZTRTN="START^PSDEA",ZTDESC="CS PHARM List DEA SPECIAL HANDLING" D ^%ZTLOAD,HOME^%ZIS K ZTSK G END
|
|---|
| 8 | U IO
|
|---|
| 9 | START ;compiles and prints data for report
|
|---|
| 10 | K ^TMP("PSDEA",$J)
|
|---|
| 11 | S (PG,PSDOUT)=0,%DT="",X="T" D ^%DT X ^DD("DD") S RPDT=Y
|
|---|
| 12 | S PSD="" F S PSD=$O(^PSDRUG("AIUN",PSD)) Q:PSD="" F NUM=0:0 S NUM=$O(^PSDRUG("AIUN",PSD,NUM)) Q:'NUM I $D(^PSDRUG(NUM,0)) D
|
|---|
| 13 | .S NODE=^PSDRUG(NUM,0),PSDN=$S($P(NODE,"^")]"":$P(NODE,"^"),1:"ZZ #"_NUM_" DRUG NAME MISSING"),PSDEA=$S($P(NODE,"^",3)]"":$P(NODE,"^",3),1:"NOT LISTED")
|
|---|
| 14 | .S PSDNDC=$S($P($G(^PSDRUG(NUM,2)),"^",4)]"":$P(^(2),"^",4),1:"NOT LISTED")
|
|---|
| 15 | .S ^TMP("PSDEA",$J,PSDN,NUM)=PSDEA_"^"_PSDNDC
|
|---|
| 16 | PRINT ;print from ^tmp
|
|---|
| 17 | K LN S $P(LN,"-",80)="" D HEADER
|
|---|
| 18 | I '$D(^TMP("PSDEA",$J)) W !!,?10,"NO DATA FOR THE DEA SPECIAL HANDLING REPORT!!",!! G DONE
|
|---|
| 19 | S PSDN="" F S PSDN=$O(^TMP("PSDEA",$J,PSDN)) Q:PSDN=""!(PSDOUT) D:$Y+5>IOSL HEADER Q:PSDOUT F NUM=0:0 S NUM=$O(^TMP("PSDEA",$J,PSDN,NUM)) Q:'NUM!(PSDOUT) D
|
|---|
| 20 | .S NODE=$G(^TMP("PSDEA",$J,PSDN,NUM))
|
|---|
| 21 | .W !,?2,PSDN,?51,$P(NODE,"^"),?65,$P(NODE,"^",2)
|
|---|
| 22 | W !
|
|---|
| 23 | DONE I $E(IOST)'="C" W @IOF
|
|---|
| 24 | I $E(IOST,1,2)="C-",'PSDOUT W ! K DIR,DIRUT S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu" D ^DIR K DIR
|
|---|
| 25 | END ;
|
|---|
| 26 | K %DT,%ZIS,DA,DEA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LN,NODE,NUM,PG,PSD,PSDEA,PSDN,PSDNDC,PSDOUT,RPDT,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSK
|
|---|
| 27 | K ^TMP("PSDEA",$J) D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 28 | Q
|
|---|
| 29 | HEADER ;prints header information
|
|---|
| 30 | I $E(IOST,1,2)="C-",PG W ! K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
|
|---|
| 31 | I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),U),"." S PSDOUT=1 Q
|
|---|
| 32 | W:$Y @IOF S PG=PG+1 W !,?15,"DEA SPECIAL HANDLING FOR CS PHARM DRUGS",!,?29,RPDT,?70,"PAGE: "_PG
|
|---|
| 33 | W !!,?48,"DEA SPECIAL",!,"DRUG NAME",?49,"HANDLING",?70,"NDC",!,LN,!
|
|---|
| 34 | Q
|
|---|
