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