source: WorldVistAEHR/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDEXP1.m@ 789

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1PSDEXP1 ;BIR/JPW-CS Drug Expiration Date Report (cont'd) ; 2 Aug 94
2 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
3 U IO
4PRINT ;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
12DONE 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
14END ;
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
19HDR ;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
Note: See TracBrowser for help on using the repository browser.