27 lines
1.6 KiB
Mathematica
27 lines
1.6 KiB
Mathematica
PSDEXP1 ;BIR/JPW-CS Drug Expiration Date Report (cont'd) ; 2 Aug 94
|
|
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|
U IO
|
|
PRINT ;print cs exp date report
|
|
S (PG,PSDOUT)=0
|
|
K LN S $P(LN,"-",80)="" D NOW^%DTC S Y=+$E(%,1,12) X ^DD("DD") S RPDT=Y
|
|
D HDR
|
|
I '$D(^TMP("PSDEXP",$J)) W !!,?15,"**** NO DRUG EXPIRATION DATA FOR THIS REPORT ****" G END
|
|
F PSD=0:0 S PSD=$O(^TMP("PSDEXP",$J,PSD)) Q:'PSD!(PSDOUT) D:$Y+5>IOSL HDR Q:PSDOUT S Y=PSD X ^DD("DD") W !!,"=> ",Y D
|
|
.S PSD1="" F S PSD1=$O(^TMP("PSDEXP",$J,PSD,PSD1)) Q:PSD1=""!(PSDOUT) D:$Y+5>IOSL HDR Q:PSDOUT W !,?12,PSD1 D
|
|
..S PSD2="" F S PSD2=$O(^TMP("PSDEXP",$J,PSD,PSD1,PSD2)) Q:PSD2=""!(PSDOUT) S PSD3="" F S PSD3=$O(^TMP("PSDEXP",$J,PSD,PSD1,PSD2,PSD3)) Q:PSD3=""!(PSDOUT) D:$Y+5>IOSL HDR Q:PSDOUT W !,?14,$S(PSD3'="N/A":PSD3,1:""),?25,PSD2
|
|
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,%H,%I,%ZIS,ANS,CNT,DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DRUG,DRUGN,DUOUT,JJ,LN,NAOU,NAOUN,NODE,OK,ORD
|
|
K PG,POP,PSD,PSDT,PSD1,PSD2,PSD3,PSDATE,PSDED,PSDIO,PSDOUT,PSDSD,RPDT,TYPE,X,Y,ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTSK
|
|
K ^TMP("PSDEXP",$J) D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|
|
HDR ;header for log
|
|
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
|
|
S PG=PG+1 W:$Y @IOF W !,?27,"CS DRUG EXPIRATION DATE REPORT",?70,"Page: ",PG
|
|
W !,?22,"FOR PERIOD ",$P(PSDATE,"^")," TO ",$P(PSDATE,"^",2)
|
|
W !,?27,"PRINTED ",RPDT,!!,"=> DATE",!,?12
|
|
I ANS="D" W "DRUG",!,?14,"DISP #",?25,"NAOU",!,LN Q
|
|
W "NAOU",!,?14,"DISP #",?25,"ITEM",!,LN
|
|
Q
|