| [613] | 1 | PSGWEXR2 ;BHAM ISC/CML-Print Drug Expiration Date Report by Selected Date Range/AOU for AOUs with Locations ; 23 Mar 93 / 12:52 PM
|
|---|
| 2 | ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
|
|---|
| 3 | PRINT ;ENTRY POINT WHEN QUEUED
|
|---|
| 4 | S PG=0,$P(LN,"-",80)="",(AOU,AOUNM,LOCNM,QFLG)=""
|
|---|
| 5 | I CNT<2 S AOU=$O(AOULP(AOU)),AOUNM=$P(^PSI(58.1,AOU,0),"^"),LOCNM=$P(^SC(AOULP(AOU),0),"^"),TAB=(80-($L(AOUNM)+$L(LOCNM)+18)*.5)
|
|---|
| 6 | PRT 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
|
|---|
| 9 | DONE I $E(IOST)'="C" W @IOF
|
|---|
| 10 | I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
|
|---|
| 11 | QUIT K %,%H,%I,%Z,AOU,ANS,QFLG,AOULP,AOUNM,BDT,DRG,DRGNM,EDT,EXDT,HDT,HH,JJ,LN,LOC,LOCFLG,LOCNM,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
|
|---|
| 13 | W1 ;
|
|---|
| 14 | D:$Y+5>IOSL PRTCHK Q:QFLG S Y=EXDT X ^DD("DD") W !!,"=> ",Y Q
|
|---|
| 15 | W2 ;
|
|---|
| 16 | D:$Y+5>IOSL PRTCHK Q:QFLG W:CNT>1 ! W !?12,P1 I SORT=2 S JJ="",JJ=$O(^TMP("PSGWEXR",$J,EXDT,P1,JJ)),AOU=^(JJ),LOC=$P(^PSI(58.1,AOU,0),"^",6) I LOC W "/(",$P(^SC(LOC,0),"^"),")"
|
|---|
| 17 | Q
|
|---|
| 18 | W3 ;
|
|---|
| 19 | 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 I SORT=1 S AOU=^TMP("PSGWEXR",$J,EXDT,P1,P2),LOC=$P(^PSI(58.1,AOU,0),"^",6) I LOC W "/(",$E($P(^SC(LOC,0),"^"),1,22),")"
|
|---|
| 20 | Q
|
|---|
| 21 | HDR ;PRINT REPORT MAIN HEADER
|
|---|
| 22 | S PG=PG+1 S HDT=$$PSGWDT^PSGWUTL1 W:$Y @IOF W !?26,"DRUG EXPIRATION DATE REPORT",?70,"PAGE ",PG I CNT<2 W !?TAB,"FOR ",AOUNM," (LOCATION - ",LOCNM,")"
|
|---|
| 23 | W !?22,"FOR PERIOD " S Y=BDT X ^DD("DD") W Y," TO " S Y=EDT X ^DD("DD") W Y,!?27,"PRINTED ",HDT,!!
|
|---|
| 24 | I $D(SEL),SEL="I",$D(IGDA) W "FOR INVENTORY GROUP - ",$P(^PSI(58.2,IGDA,0),"^"),!
|
|---|
| 25 | W "=> DATE",!?12
|
|---|
| 26 | I CNT<2 W "ITEM",!,LN Q
|
|---|
| 27 | I SORT=1 W "ITEM",!?25,"AOU/(LOCATION)",!,LN Q
|
|---|
| 28 | W "AOU/(LOCATION)",!?25,"ITEM",!,LN Q
|
|---|
| 29 | PRTCHK ;
|
|---|
| 30 | 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
|
|---|
| 31 | D HDR Q
|
|---|
