source: WorldVistAEHR/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWPSI1.m@ 1763

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1PSGWPSI1 ;BHAM/CML-Print Data for AR/WS Stock Items - CONTINUED ; 30 Aug 93 / 10:16 AM
2 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
3PRINT ;
4 S $P(LN,"-",133)="",PG=0,OUT=0,%DT="",X="T" D ^%DT X ^DD("DD") S HDT=Y D HDR
5 I '$D(^TMP("PSGWPSI",$J)) W !?43,"***** NO DATA AVAILABLE FOR THIS REPORT *****" G QUIT
6 S ITMNM="" F LL=0:0 S ITMNM=$O(^TMP("PSGWPSI",$J,ITMNM)) Q:ITMNM=""!(OUT) D:$Y+5>IOSL HDR I 'OUT W !,"=> ",ITMNM F AOU=0:0 S AOU=$O(^TMP("PSGWPSI",$J,ITMNM,AOU)) Q:'AOU!(OUT) D WRTDATA
7DONE I $E(IOST)'="C" W @IOF
8 I $E(IOST)="C"&('OUT) W !!,"Press RETURN to continue: " R AUTO:DTIME
9QUIT ;
10 K %DT,AOU,AOUNM,DRGDA,HDT,ITMDA,ITMNM,LIMIT,LINE,LN,LOC,NODE,PG,PSGWDT,LL,STKLEV,TCNT,TPNM,TYPE,WARD,WCNT,WDNM,X,Y,PSGWIO,ZTSK,ZTIO,DA,IO("Q"),AUTO,OUT
11 K ^TMP("PSGWPSI",$J) D ^%ZISC
12 S:$D(ZTQUEUED) ZTREQ="@" Q
13WRTDATA ;DATA LINES
14 S NODE=^TMP("PSGWPSI",$J,ITMNM,AOU) S AOUNM=$S($P(^PSI(58.1,AOU,0),"^")]"":$P(^(0),"^"),1:"AOU #"_AOU_"/NO NAME OR DELETED")
15 I $P(^TMP("PSGWPSI",$J,ITMNM,AOU),"^")="I" S Y=$P(^(AOU),"^",2) X ^DD("DD") D:$Y+5>IOSL HDR W !?4,AOUNM," (AOU INACTIVE AS OF ",Y,")",! Q
16 S LOC=$P(NODE,"^"),STKLEV=$P(NODE,"^",2),WARD=$P(NODE,"^",3),TYPE=$P(NODE,"^",4)
17 S WCNT=$L(WARD,";;"),TCNT=$L(TYPE,";;"),LIMIT=$S(TCNT>WCNT!(TCNT=WCNT):TCNT,WCNT>TCNT:WCNT,1:2)
18 D:$Y+5>IOSL HDR Q:OUT W !?4,AOUNM,?48,LOC,?62,STKLEV,?68 S WDNM=$P(WARD,";;",2) D:WDNM WARD W WDNM,?99 S TPNM=$P(TYPE,";;",2) D:TPNM TYPE W TPNM,!
19 I LIMIT>2 F LINE=3:1:LIMIT D:$Y+5>IOSL HDR Q:OUT W ?68 S WDNM=$P(WARD,";;",LINE) D:WDNM WARD W WDNM,?99 S TPNM=$P(TYPE,";;",LINE) D:TPNM TYPE W TPNM,!
20 Q
21WARD ;CHECK FOR WARD NAME IN ^DIC(42
22 I $D(^DIC(42,WDNM,0)),$P(^(0),"^")]"" S WDNM=$P(^(0),"^") Q
23 S WDNM="WARD #"_WDNM_"/NO NAME OR DELETED" Q
24TYPE ;CHECK FOR TYPE IN FILE #58.16
25 I $D(^PSI(58.16,TPNM,0)),$P(^(0),"^")]"" S TPNM=$P(^(0),"^") Q
26 S TPNM="TYPE #"_TPNM_"/NO NAME OR DELETED" Q
27HDR ;HEADER
28 I $E(IOST)="C"&(PG>0) S DIR(0)="E" D ^DIR K DIR I Y'=1 S OUT=1 Q
29 W:$Y @IOF S PG=PG+1 W !,HDT,?122,"PAGE: ",PG,!?53,"DATA FOR AR/WS STOCK ITEMS",!!,"=> ITEM",!?61,"STOCK",!?14,"AOU",?49,"LOCATION",?61,"LEVEL",?70,"WARD (FOR ITEM)",?104,"TYPE",!,LN,!
30 Q
Note: See TracBrowser for help on using the repository browser.