- PSDEA ;BIR/JPW-List Drug Name & DEA Special Handling ; 2 Aug 94
- ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- W !!,"This report lists Drug name, DEA Special Handling, and NDC information",!,"for all drugs marked for Controlled Substances use.",!
- DEV ;asks device and queueing information
- W !,"This report is designed for an 80 column format.",!
- K %ZIS,IOP,IO("Q"),POP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" G END
- 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
- U IO
- START ;compiles and prints data for report
- K ^TMP("PSDEA",$J)
- S (PG,PSDOUT)=0,%DT="",X="T" D ^%DT X ^DD("DD") S RPDT=Y
- 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
- .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")
- .S PSDNDC=$S($P($G(^PSDRUG(NUM,2)),"^",4)]"":$P(^(2),"^",4),1:"NOT LISTED")
- .S ^TMP("PSDEA",$J,PSDN,NUM)=PSDEA_"^"_PSDNDC
- PRINT ;print from ^tmp
- K LN S $P(LN,"-",80)="" D HEADER
- I '$D(^TMP("PSDEA",$J)) W !!,?10,"NO DATA FOR THE DEA SPECIAL HANDLING REPORT!!",!! G DONE
- 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
- .S NODE=$G(^TMP("PSDEA",$J,PSDN,NUM))
- .W !,?2,PSDN,?51,$P(NODE,"^"),?65,$P(NODE,"^",2)
- W !
- DONE I $E(IOST)'="C" W @IOF
- 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
- END ;
- 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
- K ^TMP("PSDEA",$J) D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
- Q
- 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
- I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),U),"." S PSDOUT=1 Q
- W:$Y @IOF S PG=PG+1 W !,?15,"DEA SPECIAL HANDLING FOR CS PHARM DRUGS",!,?29,RPDT,?70,"PAGE: "_PG
- W !!,?48,"DEA SPECIAL",!,"DRUG NAME",?49,"HANDLING",?70,"NDC",!,LN,!
- Q
- PSDEA ;BIR/JPW-List Drug Name & DEA Special Handling ; 2 Aug 94
- +1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- +2 WRITE !!,"This report lists Drug name, DEA Special Handling, and NDC information",!,"for all drugs marked for Controlled Substances use.",!
- DEV ;asks device and queueing information
- +1 WRITE !,"This report is designed for an 80 column format.",!
- +2 KILL %ZIS,IOP,IO("Q"),POP
- SET %ZIS="QM"
- SET %ZIS("B")=""
- DO ^%ZIS
- IF POP
- WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!"
- GOTO END
- +3 IF $DATA(IO("Q"))
- KILL IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK
- SET ZTRTN="START^PSDEA"
- SET ZTDESC="CS PHARM List DEA SPECIAL HANDLING"
- DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL ZTSK
- GOTO END
- +4 USE IO
- START ;compiles and prints data for report
- +1 KILL ^TMP("PSDEA",$JOB)
- +2 SET (PG,PSDOUT)=0
- SET %DT=""
- SET X="T"
- DO ^%DT
- XECUTE ^DD("DD")
- SET RPDT=Y
- +3 SET PSD=""
- FOR
- SET PSD=$ORDER(^PSDRUG("AIUN",PSD))
- IF PSD=""
- QUIT
- FOR NUM=0:0
- SET NUM=$ORDER(^PSDRUG("AIUN",PSD,NUM))
- IF 'NUM
- QUIT
- IF $DATA(^PSDRUG(NUM,0))
- Begin DoDot:1
- +4 SET NODE=^PSDRUG(NUM,0)
- SET PSDN=$SELECT($PIECE(NODE,"^")]"":$PIECE(NODE,"^"),1:"ZZ #"_NUM_" DRUG NAME MISSING")
- SET PSDEA=$SELECT($PIECE(NODE,"^",3)]"":$PIECE(NODE,"^",3),1:"NOT LISTED")
- +5 SET PSDNDC=$SELECT($PIECE($GET(^PSDRUG(NUM,2)),"^",4)]"":$PIECE(^(2),"^",4),1:"NOT LISTED")
- +6 SET ^TMP("PSDEA",$JOB,PSDN,NUM)=PSDEA_"^"_PSDNDC
- End DoDot:1
- PRINT ;print from ^tmp
- +1 KILL LN
- SET $PIECE(LN,"-",80)=""
- DO HEADER
- +2 IF '$DATA(^TMP("PSDEA",$JOB))
- WRITE !!,?10,"NO DATA FOR THE DEA SPECIAL HANDLING REPORT!!",!!
- GOTO DONE
- +3 SET PSDN=""
- FOR
- SET PSDN=$ORDER(^TMP("PSDEA",$JOB,PSDN))
- IF PSDN=""!(PSDOUT)
- QUIT
- IF $Y+5>IOSL
- DO HEADER
- IF PSDOUT
- QUIT
- FOR NUM=0:0
- SET NUM=$ORDER(^TMP("PSDEA",$JOB,PSDN,NUM))
- IF 'NUM!(PSDOUT)
- QUIT
- Begin DoDot:1
- +4 SET NODE=$GET(^TMP("PSDEA",$JOB,PSDN,NUM))
- +5 WRITE !,?2,PSDN,?51,$PIECE(NODE,"^"),?65,$PIECE(NODE,"^",2)
- End DoDot:1
- +6 WRITE !
- DONE IF $EXTRACT(IOST)'="C"
- WRITE @IOF
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF 'PSDOUT
- WRITE !
- KILL DIR,DIRUT
- SET DIR(0)="EA"
- SET DIR("A")="END OF REPORT! Press <RET> to return to the menu"
- DO ^DIR
- KILL DIR
- END ;
- +1 KILL %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
- +2 KILL ^TMP("PSDEA",$JOB)
- DO ^%ZISC
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +3 QUIT
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF PG
- WRITE !
- KILL DA,DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSDOUT=1
- QUIT
- +2 IF $$S^%ZTLOAD
- WRITE !!,"Task #",$GET(ZTSK),", ",$GET(ZTDESC)," was stopped by ",$PIECE($GET(^VA(200,+$GET(DUZ),0)),U),"."
- SET PSDOUT=1
- QUIT
- +3 IF $Y
- WRITE @IOF
- SET PG=PG+1
- WRITE !,?15,"DEA SPECIAL HANDLING FOR CS PHARM DRUGS",!,?29,RPDT,?70,"PAGE: "_PG
- +4 WRITE !!,?48,"DEA SPECIAL",!,"DRUG NAME",?49,"HANDLING",?70,"NDC",!,LN,!
- +5 QUIT
