source: WorldVistAEHR/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDRLOG2.m@ 1073

Last change on this file since 1073 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1PSDRLOG2 ;BIR/JPW-Inspector's Log By Date (cont'd) ; 30 Aug 94
2 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
3PRINT ;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("PSDRLOG",$J)) D HDR W !!,?45,"**** NO PENDING NARCOTIC ORDERS FOR INSPECTION ****",! G DONE
6 S NAOU="" F S NAOU=$O(^TMP("PSDRLOG",$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("PSDRLOG",$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("PSDRLOG",$J,NAOU,PSDRN,NUM)) Q:NUM=""!(PSDOUT) F PSDCNT=0:0 S PSDCNT=$O(^TMP("PSDRLOG",$J,NAOU,PSDRN,NUM,PSDCNT)) Q:'PSDCNT!(PSDOUT) D
11 ...I $Y+8>IOSL D PRT,HDR Q:PSDOUT W !,?2,"=> NAOU: ",NAOU,! S LNUM=$Y
12 ...S NODE=$G(^TMP("PSDRLOG",$J,NAOU,PSDRN,NUM,PSDCNT))
13 ...W ! W:$P(NODE,"^",4)["*" $P(NODE,U,4)
14 ...W ?2,$S(ASK="N":PSDRN,1:NUM),?13,$S(ASK="D":PSDRN,1:NUM),?55
15 ...W:$P(NODE,U,4)'="#" $P(NODE,"^",2)
16 ...W ?70,$J($P(NODE,"^"),6),?85,$P(NODE,"^",3)
17 ...W:$P(NODE,U,4)="#" ?100,$P(NODE,U,2) W ?118,"____________",!
18 ...W:$P(NODE,"^",5)]"" ?13,"(TRANSFERRED TO "_$P(NODE,"^",5)_")",!
19 ...S LNUM=$Y
20DONE I $E(IOST)'="C" W @IOF
21 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
22END K %,%H,%I,%ZIS,ALL,ANS,ASK,ASKN,CNT,COMM,DA,DIC,DIE,DIR,DIROUT,DIRUT,DIWF,DIWL,DIWR,DR,DTOUT,DUOUT,EXP,EXPD,FLAG,JJ,KK,LN,LOOP,LNUM,LOT,MFG,NAOU,NODE,NODE1,NODE3,NODE7,NUM
23 K OK,ORD,ORDN,PG,PSD,PSDA,PSDATE,PSDCNT,PSDDT,PSDG,PSDIO,PSDOK,PSDN,PSDNA,PSDOUT,PSDR,PSDRD,PSDRET,PSDRN,PSDSD,PSDST,PSDTR,PSDTYP,QTY,REQD,REQDT,RPDT,RQTY
24 K SEL,STAT,STATN,TEXT,TYP,TYPN,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
25 K ^TMP("PSDRLOG",$J) D ^%ZISC
26 S:$D(ZTQUEUED) ZTREQ="@"
27 Q
28HDR ;header for log
29 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
30 S PG=PG+1 W:$Y @IOF W !,?42,"Inspector's Log for Controlled Substances",?120,"Page: ",PG,!,?52,RPDT,!
31 W !,?57,"DATE",?71,"QTY"
32 W !,"DISP #",?13,"DRUG",?55,"RECEIVED",?68,"RECEIVED",?85,"EXP DATE"
33 W:$G(PSDRET) ?100,"DATE RETURNED" W ?118,"NAME/DATE"
34 W !,LN,!
35 Q
36LOOP2 ;print inv typ loop
37 S TYPN="" F S TYPN=$O(^TMP("PSDRLOG",$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
38 .S PSDRN="" F S PSDRN=$O(^TMP("PSDRLOG",$J,NAOU,TYPN,PSDRN)) Q:PSDRN=""!(PSDOUT) D Q:PSDOUT
39 ..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
40 ..S NUM="" F S NUM=$O(^TMP("PSDRLOG",$J,NAOU,TYPN,PSDRN,NUM)) Q:NUM=""!(PSDOUT) F PSDCNT=0:0 S PSDCNT=$O(^TMP("PSDRLOG",$J,NAOU,TYPN,PSDRN,NUM,PSDCNT)) Q:'PSDCNT!(PSDOUT) D Q:PSDOUT
41 ...I $Y+8>IOSL D PRT,HDR Q:PSDOUT W !,?2,"=> NAOU: ",NAOU,! W:ASKN !,?4,"=> INVENTORY TYPE: ",TYPN,! S LNUM=$Y
42 ...S NODE=$G(^TMP("PSDRLOG",$J,NAOU,TYPN,PSDRN,NUM,PSDCNT))
43 ...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,"____________",!
44 ...W:$P(NODE,"^",5)]"" ?13,"(TRANSFERRED TO "_$P(NODE,"^",5)_")",!
45 ...S LNUM=$Y
46 Q
47PRT ;
48 I LNUM<IOSL-7 F JJ=LNUM:1:IOSL-7 W !
49 W !,LN,!,"* - Transferred to another NAOU",!,"** - Received from another NAOU",!
50 Q
Note: See TracBrowser for help on using the repository browser.