Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSDPLOG3

PSDPLOG3.m

Go to the documentation of this file.
  1. PSDPLOG3 ;BIR/JPW,LTL - Inspector's Log (cont'd) ;31 May 95
  1. ;;3.0;CONTROLLED SUBSTANCES;**73**;13 Feb 97;Build 8
  1. PRINT ;print inspector's log by naou, drug and green sheet #
  1. S (PG,PSDOUT,NAOU)=0 D NOW^%DTC S Y=+$E(%,1,12) X ^DD("DD") S RPDT=Y
  1. K LN S $P(LN,"-",132)="" I '$D(^TMP("PSDLOG",$J)) D HDR W !!,?45,"**** NO PENDING NARCOTIC ORDERS FOR INSPECTION ****",! G DONE
  1. S NAOU="" F S NAOU=$O(^TMP("PSDLOG",$J,"B",NAOU)) Q:NAOU=""!(PSDOUT) D HDR Q:PSDOUT W !,?2,"=> NAOU: ",NAOU,! S LNUM=$Y D LOOP2 Q:PSDOUT D PRT
  1. D:'PSDOUT PRT
  1. DONE I $E(IOST)'="C" W @IOF
  1. 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
  1. 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
  1. 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
  1. K SEL,STAT,STATN,TEXT,TYP,TYPN,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1. K ^TMP("PSDLOG",$J) D ^%ZISC
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. Q
  1. HDR ;header for log
  1. 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
  1. S PG=PG+1 W:$Y @IOF W !,?42,"Inspector's Log for Controlled Substances",?120,"Page: ",PG,!,?52,RPDT,!
  1. W !,?67,"DATE",?80,"QTY"
  1. W !,"DISP #",?13,"DRUG",?65,"DISPENSED",?78,"DISPENSED",?91,"EXP DATE",?104,"QTY ON HAND",?118,"NAME/DATE"
  1. W !,LN,!
  1. Q
  1. LOOP2 ;print inv typ loop
  1. S NAOU(1)=$O(^TMP("PSDLOG",$J,"B",NAOU,0))
  1. S TYPN="" F S TYPN=$O(^TMP("PSDLOG",$J,NAOU(1),"B",TYPN)) Q:TYPN=""!(PSDOUT) W !,?4,"=> INVENTORY TYPE: ",$S($E(TYPN,1,2)="ZZ":$E(TYPN,3,99),1:TYPN),! S LNUM=$Y D
  1. .S TYPN(1)=$O(^TMP("PSDLOG",$J,NAOU(1),"B",TYPN,0))
  1. .I ASK="N" D Q
  1. ..S NUM=0
  1. ..F S NUM=$O(^TMP("PSDLOG",$J,NAOU(1),TYPN(1),NUM)) Q:NUM=""!(PSDOUT) D Q:PSDOUT
  1. ...I $Y+8>IOSL D PRT,HDR Q:PSDOUT W !,?2,"=> NAOU: ",NAOU,!!?4,"=> INVENTORY TYPE: ",$S($E(TYPN,1,2)="ZZ":$E(TYPN,3,99),1:TYPN),! S LNUM=$Y
  1. ...S PSDR=0
  1. ...F S PSDR=$O(^TMP("PSDLOG",$J,NAOU(1),TYPN(1),NUM,PSDR)) Q:'PSDR!(PSDOUT) S PSDCNT=0 F S PSDCNT=$O(^TMP("PSDLOG",$J,NAOU(1),TYPN(1),NUM,PSDR,PSDCNT)) Q:'PSDCNT!(PSDOUT) D Q:PSDOUT
  1. ....I $Y+8>IOSL D PRT,HDR Q:PSDOUT W !,?2,"=> NAOU: ",NAOU,!!?4,"=> INVENTORY TYPE: ",$S($E(TYPN,1,2)="ZZ":$E(TYPN,3,99),1:TYPN),! S LNUM=$Y
  1. ....S NODE=$G(^TMP("PSDLOG",$J,NAOU(1),TYPN(1),NUM,PSDR,PSDCNT))
  1. ....W !,$P(NODE,U,4),?2,NUM,?13,$P(NODE,U,5)_$$SCH^PSDPLOG2(PSDR),?65,$P(NODE,U,2),?72,$J($P(NODE,U),6),?91,$P(NODE,U,3),?104,"____________",?118,"____________",! S LNUM=$Y
  1. .S PSDRN="" F S PSDRN=$O(^TMP("PSDLOG",$J,NAOU(1),TYPN(1),"B",PSDRN)) Q:PSDRN=""!(PSDOUT) D Q:PSDOUT
  1. ..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
  1. ..S PSDRN(1)=$O(^TMP("PSDLOG",$J,NAOU(1),TYPN(1),"B",PSDRN,0))
  1. ..S NUM="" F S NUM=$O(^TMP("PSDLOG",$J,NAOU(1),TYPN(1),PSDRN(1),NUM)) Q:NUM=""!(PSDOUT) F PSDCNT=0:0 S PSDCNT=$O(^TMP("PSDLOG",$J,NAOU(1),TYPN(1),PSDRN(1),NUM,PSDCNT)) Q:'PSDCNT!(PSDOUT) D Q:PSDOUT
  1. ...I $Y+8>IOSL D PRT,HDR Q:PSDOUT W !,?2,"=> NAOU: ",NAOU,! W:ASKN !,?4,"=> INVENTORY TYPE: ",TYPN,! S LNUM=$Y
  1. ...S NODE=$G(^TMP("PSDLOG",$J,NAOU(1),TYPN(1),PSDRN(1),NUM,PSDCNT))
  1. ...W !,$P(NODE,"^",4),?2,$S(ASK="N":PSDRN,1:NUM),?13,$S(ASK="D":PSDRN,1:NUM),$$SCH^PSDPLOG2(PSDRN(1)),?65,$P(NODE,"^",2),?72,$J($P(NODE,"^"),6),?91,$P(NODE,"^",3),?104,"____________",?118,"____________",!
  1. ...S LNUM=$Y
  1. Q
  1. PRT ;
  1. I LNUM<IOSL-7 F JJ=LNUM:1:IOSL-7 W !
  1. W LN,!,"* - Transferred to another NAOU but not yet received",!,"** - Filled not yet received",!,"# - Returned to Stock",!
  1. Q