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