source: WorldVistAEHR/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWEXR1.m@ 975

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1PSGWEXR1 ;BHAM ISC/CML-Print Drug Expiration Date Report by Selected Date Range/AOU ; 23 Mar 93 / 12:51 PM
2 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
3PRINT ;ENTRY POINT WHEN QUEUED
4 S PG=0,$P(LN,"-",80)="",(AOU,AOUNM,QFLG)=""
5 I CNT<2 S AOU=$O(AOULP(AOU)),AOUNM=$P(^PSI(58.1,AOU,0),"^")
6PRT S TAB=$S(CNT<2:(80-(32+$L(AOUNM)))*.5,1:26) D HDR
7 I '$D(^TMP("PSGWEXR",$J)) W !!,"NO DATA FOUND FOR THIS REPORT" G DONE
8 F EXDT=0:0 S EXDT=$O(^TMP("PSGWEXR",$J,EXDT)) Q:'EXDT!(QFLG) D W1 Q:QFLG S P1="" F JJ=0:0 S P1=$O(^TMP("PSGWEXR",$J,EXDT,P1)) Q:P1="" D W2 Q:QFLG I CNT>1 S P2="" D W3 Q:QFLG
9DONE I $E(IOST)'="C" W @IOF
10 I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
11QUIT K %,%H,%I,%Z,AOU,ANS,QFLG,AOULP,AOUNM,BDT,DRG,DRGNM,EDT,EXDT,HDT,HH,JJ,LN,PG,X,Y,SEL,IGDA,CNT,SORT,P1,P2,G,TAB,ZTSK,IO("Q"),^TMP("PSGWEXR",$J) D ^%ZISC
12 S:$D(ZTQUEUED) ZTREQ="@" Q
13W1 ;
14 D:$Y+5>IOSL PRTCHK Q:QFLG S Y=EXDT X ^DD("DD") W !!,"=> ",Y Q
15W2 ;
16 D:$Y+5>IOSL PRTCHK Q:QFLG W:CNT>1 ! W !?12,P1 Q
17W3 ;
18 F HH=0:0 S P2=$O(^TMP("PSGWEXR",$J,EXDT,P1,P2)) Q:P2="" D:$Y+5>IOSL PRTCHK Q:QFLG W !,?25,P2
19 Q
20HDR ;PRINT REPORT MAIN HEADER
21 S PG=PG+1 S HDT=$$PSGWDT^PSGWUTL1 W:$Y @IOF W !?TAB,"DRUG EXPIRATION DATE REPORT" I CNT<2 W " for ",AOUNM
22 W ?70,"PAGE ",PG,!?22,"FOR PERIOD " S Y=BDT X ^DD("DD") W Y," TO " S Y=EDT X ^DD("DD") W Y,!?27,"PRINTED ",HDT,!!
23 I $D(SEL),SEL="I",$D(IGDA) W "FOR INVENTORY GROUP - ",$P(^PSI(58.2,IGDA,0),"^"),!
24 W "=> DATE",!?12
25 I CNT<2 W "ITEM",!,LN Q
26 I SORT=1 W "ITEM",!?25,"AOU",!,LN Q
27 W "AOU",!?25,"ITEM",!,LN Q
28PRTCHK ;
29 I $E(IOST)="C" W !!,"Press <RETURN> to Continue or ""^"" to Exit: " R ANS:DTIME S:'$T ANS="^" D:ANS?1."?" HELP^PSGWUTL1 I ANS="^" S QFLG=1 Q
30 D HDR Q
Note: See TracBrowser for help on using the repository browser.