- PSDPSTK ;BIR/JPW-Print Data for CS Stock Drugs ; 7 Sept 92
- ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)
- W !!,"This report lists data stored for CS Stock Drugs.",!!,"This report is designed for a 132 column format.",!,"You may queue this report to print at a later time.",!!
- I '$O(^PSD(58.8,0)) W !!,"You MUST create NAOUs before running this report!" Q
- D NOW^%DTC S PSDT=X
- DEV ;ask device and queueing information
- 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") S PSDIO=ION,ZTIO="" K ZTSAVE,ZTDTH,ZTSK S ZTRTN="START^PSDPSTK",ZTDESC="Compile Data for CS PHARM Stock Drugs",ZTSAVE("PSDIO")="",ZTSAVE("PSDSITE")="",ZTSAVE("PSDT")="" D ^%ZTLOAD K ZTSK G END
- U IO
- START ;compile data for stock drug report
- K ^TMP("PSDPSTK",$J)
- F NAOU=0:0 S NAOU=$O(^PSD(58.8,NAOU)) G:('NAOU)&($D(ZTQUEUED)) PRTQUE G:'NAOU PRINT^PSDPSTK1 I $D(^PSD(58.8,NAOU,0)),$P(^(0),"^",3)=+PSDSITE,$P(^(0),"^",2)'="P" F DRUG=0:0 S DRUG=$O(^PSD(58.8,NAOU,1,DRUG)) Q:'DRUG D
- .Q:'$D(^PSD(58.8,NAOU,1,DRUG,0)) I +$P(^PSD(58.8,NAOU,1,DRUG,0),"^",14) D NOW^%DTC I $P(^PSD(58.8,NAOU,1,DRUG,0),"^",14)'>X Q
- .Q:'$D(^PSDRUG(DRUG,0)) I $D(^PSDRUG(DRUG,0)) S DRUGN=$S($P(^PSDRUG(DRUG,0),"^")]"":$P(^(0),"^"),1:"ZZ/"_DRUG)
- .I $D(^PSD(58.8,NAOU,"I")),$P(^("I"),"^"),$P(^("I"),"^")'>PSDT S ^TMP("PSDPSTK",$J,DRUGN,NAOU,0)="I^"_$P(^("I"),"^") Q
- .S NODE=^PSD(58.8,NAOU,1,DRUG,0),LOC=$S($P(NODE,"^",2)]"":$P(NODE,"^",2),1:"NONE"),STK=$S($P(NODE,"^",3)]"":$P(NODE,"^",3),1:"NONE")
- .S TYPE="" F TYP=0:0 S TYP=$O(^PSD(58.8,NAOU,1,DRUG,2,TYP)) Q:'TYP S TYPE=TYPE_";;"_TYP
- .S WARD="" F WRD=0:0 S WRD=$O(^PSD(58.8,NAOU,1,DRUG,1,WRD)) Q:'WRD S WARD=WARD_";;"_WRD
- .S:TYPE="" TYPE=";;NONE" S:WARD="" WARD=";;NONE" S ^TMP("PSDPSTK",$J,DRUGN,NAOU,0)=LOC_"^"_STK_"^"_TYPE
- .S ^TMP("PSDPSTK",$J,DRUGN,NAOU,1)=WARD
- Q
- END ;
- K %,%H,%I,%ZIS,DA,DATEI,DIK,DRUG,DRUGN,IO("Q"),LOC,NAOU,NODE,POP,PSDIO,PSDT,STK,TYP,TYPE,WARD,WRD
- K X,Y,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN,^TMP("PSDPSTK",$J) D ^%ZISC
- S:$D(ZTQUEUED) ZTREQ="@"
- Q
- PRTQUE ;queues print after data is compiled
- K ZTSAVE,ZTIO S ZTIO=PSDIO,ZTRTN="PRINT^PSDPSTK1",ZTDESC="Print Data for CS PHARM Stock Drugs",ZTDTH=$H,ZTSAVE("^TMP(""PSDPSTK"",$J,")=""
- D ^%ZTLOAD K ^TMP("PSDPSTK",$J) K ZTSK G END
- PSDPSTK ;BIR/JPW-Print Data for CS Stock Drugs ; 7 Sept 92
- +1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- +2 IF '$DATA(PSDSITE)
- DO ^PSDSET
- IF '$DATA(PSDSITE)
- QUIT
- +3 WRITE !!,"This report lists data stored for CS Stock Drugs.",!!,"This report is designed for a 132 column format.",!,"You may queue this report to print at a later time.",!!
- +4 IF '$ORDER(^PSD(58.8,0))
- WRITE !!,"You MUST create NAOUs before running this report!"
- QUIT
- +5 DO NOW^%DTC
- SET PSDT=X
- DEV ;ask device and queueing information
- +1 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
- +2 IF $DATA(IO("Q"))
- KILL IO("Q")
- SET PSDIO=ION
- SET ZTIO=""
- KILL ZTSAVE,ZTDTH,ZTSK
- SET ZTRTN="START^PSDPSTK"
- SET ZTDESC="Compile Data for CS PHARM Stock Drugs"
- SET ZTSAVE("PSDIO")=""
- SET ZTSAVE("PSDSITE")=""
- SET ZTSAVE("PSDT")=""
- DO ^%ZTLOAD
- KILL ZTSK
- GOTO END
- +3 USE IO
- START ;compile data for stock drug report
- +1 KILL ^TMP("PSDPSTK",$JOB)
- +2 FOR NAOU=0:0
- SET NAOU=$ORDER(^PSD(58.8,NAOU))
- IF ('NAOU)&($DATA(ZTQUEUED))
- GOTO PRTQUE
- IF 'NAOU
- GOTO PRINT^PSDPSTK1
- IF $DATA(^PSD(58.8,NAOU,0))
- IF $PIECE(^(0),"^",3)=+PSDSITE
- IF $PIECE(^(0),"^",2)'="P"
- FOR DRUG=0:0
- SET DRUG=$ORDER(^PSD(58.8,NAOU,1,DRUG))
- IF 'DRUG
- QUIT
- Begin DoDot:1
- +3 IF '$DATA(^PSD(58.8,NAOU,1,DRUG,0))
- QUIT
- IF +$PIECE(^PSD(58.8,NAOU,1,DRUG,0),"^",14)
- DO NOW^%DTC
- IF $PIECE(^PSD(58.8,NAOU,1,DRUG,0),"^",14)'>X
- QUIT
- +4 IF '$DATA(^PSDRUG(DRUG,0))
- QUIT
- IF $DATA(^PSDRUG(DRUG,0))
- SET DRUGN=$SELECT($PIECE(^PSDRUG(DRUG,0),"^")]"":$PIECE(^(0),"^"),1:"ZZ/"_DRUG)
- +5 IF $DATA(^PSD(58.8,NAOU,"I"))
- IF $PIECE(^("I"),"^")
- IF $PIECE(^("I"),"^")'>PSDT
- SET ^TMP("PSDPSTK",$JOB,DRUGN,NAOU,0)="I^"_$PIECE(^("I"),"^")
- QUIT
- +6 SET NODE=^PSD(58.8,NAOU,1,DRUG,0)
- SET LOC=$SELECT($PIECE(NODE,"^",2)]"":$PIECE(NODE,"^",2),1:"NONE")
- SET STK=$SELECT($PIECE(NODE,"^",3)]"":$PIECE(NODE,"^",3),1:"NONE")
- +7 SET TYPE=""
- FOR TYP=0:0
- SET TYP=$ORDER(^PSD(58.8,NAOU,1,DRUG,2,TYP))
- IF 'TYP
- QUIT
- SET TYPE=TYPE_";;"_TYP
- +8 SET WARD=""
- FOR WRD=0:0
- SET WRD=$ORDER(^PSD(58.8,NAOU,1,DRUG,1,WRD))
- IF 'WRD
- QUIT
- SET WARD=WARD_";;"_WRD
- +9 IF TYPE=""
- SET TYPE=";;NONE"
- IF WARD=""
- SET WARD=";;NONE"
- SET ^TMP("PSDPSTK",$JOB,DRUGN,NAOU,0)=LOC_"^"_STK_"^"_TYPE
- +10 SET ^TMP("PSDPSTK",$JOB,DRUGN,NAOU,1)=WARD
- End DoDot:1
- +11 QUIT
- END ;
- +1 KILL %,%H,%I,%ZIS,DA,DATEI,DIK,DRUG,DRUGN,IO("Q"),LOC,NAOU,NODE,POP,PSDIO,PSDT,STK,TYP,TYPE,WARD,WRD
- +2 KILL X,Y,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN,^TMP("PSDPSTK",$JOB)
- DO ^%ZISC
- +3 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +4 QUIT
- PRTQUE ;queues print after data is compiled
- +1 KILL ZTSAVE,ZTIO
- SET ZTIO=PSDIO
- SET ZTRTN="PRINT^PSDPSTK1"
- SET ZTDESC="Print Data for CS PHARM Stock Drugs"
- SET ZTDTH=$HOROLOG
- SET ZTSAVE("^TMP(""PSDPSTK"",$J,")=""
- +2 DO ^%ZTLOAD
- KILL ^TMP("PSDPSTK",$JOB)
- KILL ZTSK
- GOTO END
