| [613] | 1 | PSDPLOG2 ;BIR/JPW-Inspector's Log (cont'd) ; 2 Aug 94
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|---|
| 3 | PRINT ;print inspector's log by naou, drug and green sheet #
|
|---|
| 4 | S (PG,PSDOUT,NAOU)=0 D NOW^%DTC S Y=+$E(%,1,12) X ^DD("DD") S RPDT=Y
|
|---|
| 5 | K LN S $P(LN,"-",132)="" I '$D(^TMP("PSDLOG",$J)) D HDR W !!,?45,"**** NO PENDING NARCOTIC ORDERS FOR INSPECTION ****",! G DONE
|
|---|
| 6 | S NAOU="" F S NAOU=$O(^TMP("PSDLOG",$J,NAOU)) Q:NAOU=""!(PSDOUT) D HDR Q:PSDOUT W !,?2,"=> NAOU: ",NAOU,! S LNUM=$Y D Q:PSDOUT D PRT
|
|---|
| 7 | .I ASKN D LOOP2 Q
|
|---|
| 8 | .S PSDRN="" F S PSDRN=$O(^TMP("PSDLOG",$J,NAOU,PSDRN)) Q:PSDRN=""!(PSDOUT) D Q:PSDOUT
|
|---|
| 9 | ..I $Y+8>IOSL D PRT,HDR Q:PSDOUT W !,?2,"=> NAOU: ",NAOU,! S LNUM=$Y
|
|---|
| 10 | ..S NUM="" F S NUM=$O(^TMP("PSDLOG",$J,NAOU,PSDRN,NUM)) Q:NUM=""!(PSDOUT) F PSDCNT=0:0 S PSDCNT=$O(^TMP("PSDLOG",$J,NAOU,PSDRN,NUM,PSDCNT)) Q:'PSDCNT!(PSDOUT) D Q:PSDOUT
|
|---|
| 11 | ...I $Y+8>IOSL D PRT,HDR Q:PSDOUT W !,?2,"=> NAOU: ",NAOU,! S LNUM=$Y
|
|---|
| 12 | ...S NODE=$G(^TMP("PSDLOG",$J,NAOU,PSDRN,NUM,PSDCNT))
|
|---|
| 13 | ...W !,$P(NODE,"^",4),?2,$S(ASK="N":PSDRN,1:NUM),?13,$S(ASK="D":PSDRN,1:NUM),?55,$P(NODE,"^",2),?70,$J($P(NODE,"^"),6),?85,$P(NODE,"^",3),?100,"____________",?118,"____________",!
|
|---|
| 14 | ...S LNUM=$Y
|
|---|
| 15 | DONE I $E(IOST)'="C" W @IOF
|
|---|
| 16 | 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
|
|---|
| 17 | END K %,%DT,%H,%I,%ZIS,ALL,ANS,ASK,ASKN,CNT,COMM,DA,DIC,DIE,DIR,DIROUT,DIRUT,DIWF,DIWL,DIWR,DR,DTOUT,DUOUT,EXP,EXPD,JJ,LN,LNUM,LOOP,LOT,MFG,NAOU,NODE,NODE3,NUM
|
|---|
| 18 | K OK,ORD,ORDN,PG,PSD,PSDA,PSDCNT,PSDDT,PSDG,PSDIO,PSDOK,PSDN,PSDNA,PSDOUT,PSDR,PSDRN,PSDSD,PSDST,PSDT,PSDTR,QTY,REQD,REQDT,RPDT,RQTY
|
|---|
| 19 | K SEL,STAT,STATN,TEXT,TYP,TYPN,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
|
|---|
| 20 | K ^TMP("PSDLOG",$J) D ^%ZISC
|
|---|
| 21 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 22 | Q
|
|---|
| 23 | HDR ;header for log
|
|---|
| 24 | 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
|
|---|
| 25 | S PG=PG+1 W:$Y @IOF W !,?42,"Inspector's Log for Controlled Substances",?120,"Page: ",PG,!,?52,RPDT,!
|
|---|
| 26 | W !,?57,"DATE",?71,"QTY"
|
|---|
| 27 | W !,"DISP #",?13,"DRUG",?55,"DISPENSED",?68,"DISPENSED",?85,"EXP DATE",?100,"QTY ON HAND",?118,"NAME/DATE"
|
|---|
| 28 | W !,LN,!
|
|---|
| 29 | Q
|
|---|
| 30 | LOOP2 ;print inv typ loop
|
|---|
| 31 | S TYPN="" F S TYPN=$O(^TMP("PSDLOG",$J,NAOU,TYPN)) Q:TYPN=""!(PSDOUT) W !,?4,"=> INVENTORY TYPE: ",$S($E(TYPN,1,2)="ZZ":$E(TYPN,3,99),1:TYPN),! S LNUM=$Y D
|
|---|
| 32 | .S PSDRN="" F S PSDRN=$O(^TMP("PSDLOG",$J,NAOU,TYPN,PSDRN)) Q:PSDRN=""!(PSDOUT) D Q:PSDOUT
|
|---|
| 33 | ..I $Y+8>IOSL D PRT,HDR Q:PSDOUT W !,?2,"=> NAOU: ",NAOU,! W:ASKN !,?4,"=> INVENTORY TYPE: ",$S($E(TYPN,1,2)="ZZ":$E(TYPN,3,99),1:TYPN),! S LNUM=$Y
|
|---|
| 34 | ..S NUM="" F S NUM=$O(^TMP("PSDLOG",$J,NAOU,TYPN,PSDRN,NUM)) Q:NUM=""!(PSDOUT) F PSDCNT=0:0 S PSDCNT=$O(^TMP("PSDLOG",$J,NAOU,TYPN,PSDRN,NUM,PSDCNT)) Q:'PSDCNT!(PSDOUT) D Q:PSDOUT
|
|---|
| 35 | ...I $Y+8>IOSL D PRT,HDR Q:PSDOUT W !,?2,"=> NAOU: ",NAOU,! W:ASKN !,?4,"=> INVENTORY TYPE: ",TYPN,! S LNUM=$Y
|
|---|
| 36 | ...S NODE=$G(^TMP("PSDLOG",$J,NAOU,TYPN,PSDRN,NUM,PSDCNT))
|
|---|
| 37 | ...W !,$P(NODE,"^",4),?2,$S(ASK="N":PSDRN,1:NUM),?13,$S(ASK="D":PSDRN,1:NUM),?55,$P(NODE,"^",2),?70,$J($P(NODE,"^"),6),?85,$P(NODE,"^",3),?100,"____________",?118,"____________",!
|
|---|
| 38 | ...S LNUM=$Y
|
|---|
| 39 | Q
|
|---|
| 40 | PRT ;
|
|---|
| 41 | I LNUM<IOSL-7 F JJ=LNUM:1:IOSL-7 W !
|
|---|
| 42 | W LN,!,"* - Transferred to another NAOU but not yet received",!,"** - Filled not yet received",!,"# - Returned to Stock",!
|
|---|
| 43 | Q
|
|---|
