source: WorldVistAEHR/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWHC1.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1PSGWHC1 ;BHAM ISC/PTD,CML-Print High Cost Report for Selected Date Range - CONTINUED ; 23 Mar 93 / 12:53 PM
2 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
3EN1 S (UT1,UT2,CNT)=0,PGCT=1,QFLG="" D HDR I '$D(^TMP("PSGWHC",$J,"HI")) W !!,"NO DATA AVAILABLE FOR SELECTED DATES." G DONE
4UT1LP S UT1=$O(^TMP("PSGWHC",$J,"HI",UT1)) I UT1="" W !!,"# of Items: ",CNT G DONE
5UT2LP S UT2=$O(^TMP("PSGWHC",$J,"HI",UT1,UT2)) G:UT2="" UT1LP S LOC=^TMP("PSGWHC",$J,"HI",UT1,UT2),DRG=$S(SORT=2:UT1,1:UT2)
6 D:$Y+4>IOSL PRTCHK G:QFLG END W !,DRG,?44,$S($P(LOC,"^")'="NO DATA":$J($P(LOC,"^"),10,2),1:"COST DATA MISSING"),?64,$J($P(LOC,"^",2),8,0) S CNT=CNT+1 G UT2LP
7 ;
8DONE I $E(IOST)'="C" W @IOF
9 I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
10END K ALL,AOU,AOUCST,AOUQD,BDT,DRG,DRGCST,DRGDA,DRGNAME,DRGNM,DRGQD,EDT,INACTOT,INC,INVDA,INVDT,INVN,J,LOC,LOC1,LOC2,LOCSR,LOCWD,ODA,ODT,PGCT,PRCNT,PRCT,QD,RETDT,SORT,SRV,SRVDA,UT1,UT2,WARD,WDN,WRDA,WRDDA,ZTSK,X
11 K ANS,QFLG,AOUN,CF,CNT,CST,CUT,DRN,DRUG,LOCN,QUAN,TOTCST,TOTQD,PSGWIO,PSGWION,%,%I,%H,G,ZTIO,^TMP("PSGWHC",$J),ZTSK,IO("Q") D ^%ZISC
12 S:$D(ZTQUEUED) ZTREQ="@" Q
13 ;
14HDR ;PRINT REPORT MAIN HEADER
15 W:$Y @IOF W !,"HIGH COST REPORT AR/WS - ",$S(ALL=1:"FOR ALL AOUS",1:$P(^PSI(58.1,AOU,0),"^")),?70,"PAGE ",PGCT,!,"TOTAL COST GREATER THAN OR EQUAL TO $",CUT
16 W !,"FROM " S Y=BDT X ^DD("DD") W Y," TO " S Y=EDT X ^DD("DD") W Y
17 W !!?53,"DATE: ",$$PSGWDT^PSGWUTL1 S PGCT=PGCT+1
18 W !?5,"ITEM",?45,"TOTAL COST",?60,"QUANTITY DISPENSED",! F J=1:1:80 W "-"
19 Q
20PRTCHK ;
21 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
22 D HDR Q
Note: See TracBrowser for help on using the repository browser.