[613] | 1 | PSGWNU1 ;BHAM ISC/PTD,CML-Print Drugs (Items) with NO Usage for Selected Date Range - CONTINUED ; 23 Mar 93 / 12:54 PM
|
---|
| 2 | ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
|
---|
| 3 | PRINT ;PRINT ZERO USAGE REPORT FOR ALL DRUGS BY AOU
|
---|
| 4 | S PGCT=1,(AOU,QFLG)="" D NOW^%DTC S CURDT=$P(%,".") I $O(^TMP("PSGWNU",$J,AOU))']"" D HDR W !,"NO ITEMS WITH ZERO USAGE FOR SELECTED DATE RANGE." G DONE
|
---|
| 5 | AOULP S AOU=$O(^TMP("PSGWNU",$J,AOU)) G:'AOU DONE D PRTCHK G:QFLG END W !,"==> ",$P(^PSI(58.1,AOU,0),"^") S DRG=0
|
---|
| 6 | DRLP S DRG=$O(^TMP("PSGWNU",$J,AOU,DRG)) D:DRG=""&($E(IOST)'="C") MSG G:DRG="" AOULP D:$Y+7>IOSL PRTCHK G:QFLG END
|
---|
| 7 | S LOC=^TMP("PSGWNU",$J,AOU,DRG),AR=$P(LOC,"^"),OD=$P(LOC,"^",2),LSTDT=$S((AR'<OD):AR,(OD'<AR):OD,1:""),RET=$P(LOC,"^",3)
|
---|
| 8 | W ! I LSTDT'="" S X1=CURDT,X2=LSTDT D ^%DTC S ASTER=X\90 S:ASTER<0 ASTER=0 I ASTER>0 F J=1:1:ASTER W "*"
|
---|
| 9 | W ?8,DRG I LSTDT'="" S Y=LSTDT X ^DD("DD") W ?48,$P(Y,"@") W:RET="Y" ?64,"INCLUDES RETURNS" G DRLP
|
---|
| 10 | I LSTDT="" W ?48,"NO DISPENSE DATES FOUND" G DRLP
|
---|
| 11 | ;
|
---|
| 12 | DONE I $E(IOST)'="C" W @IOF
|
---|
| 13 | I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
|
---|
| 14 | END K ^TMP("PSGWNU",$J),AOU,ALL,BDT,DRG,DRGDA,DRGNAME,DRGNM,DRGQD,EDT,INVDA,INVDT,INVN,J,ODA,ODT,PGCT,QD,RETDT,AR,ARDT,LOC,LSTDT,OD,RET,RFLG,JJ,AOULP,ASTER,CURDT,PSGWIO,ZTSK,X,Y,ANS,QFLG
|
---|
| 15 | K %,%I,%H,ZTIO,DA,G,SEL,IGDA,IO("Q") D ^%ZISC
|
---|
| 16 | S:$D(ZTQUEUED) ZTREQ="@" Q
|
---|
| 17 | ;
|
---|
| 18 | HDR ;PRINT REPORT HEADER
|
---|
| 19 | W:$Y @IOF W !,"ITEMS WITH ZERO USAGE FROM " S Y=BDT X ^DD("DD") W Y," TO " S Y=EDT X ^DD("DD") W Y,?70,"PAGE ",PGCT I $D(SEL),SEL="I",$D(IGDA) W !,"FOR INVENTORY GROUP - ",$P(^PSI(58.2,IGDA,0),"^")
|
---|
| 20 | W !!,"AREA OF USE",?55,"DATE: ",$$PSGWDT^PSGWUTL1
|
---|
| 21 | W !?8,"NO USAGE FOR:",?45,"DATE LAST DISPENSED:",! S PGCT=PGCT+1 F J=1:1:80 W "-"
|
---|
| 22 | Q
|
---|
| 23 | ;
|
---|
| 24 | MSG W !!!,"For each ""*"" printed, 90 days have passed from",!,"the date item was last dispensed to current date."
|
---|
| 25 | Q
|
---|
| 26 | PRTCHK ;
|
---|
| 27 | I PGCT>1&($E(IOST)="C") D MSG 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
|
---|
| 28 | D HDR Q
|
---|