source: FOIAVistA/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWLSI1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1PSGWLSI1 ;BHAM ISC/PTD,CML-Print Stock Items in Order by Type/Location ; 03 Sep 93 / 9:35 AM
2 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
3ENQ ;ENTRY POINT WHEN QUEUED
4 K ^TMP("PSGWSTK",$J) S PGCT=1,$P(LN,"-",132)="",AOU=0,OUT=0
5AOU S AOU=$O(AOULP(AOU)) G:'AOU PRINT
6 ;
7XREF F DRGNM=0:0 S DRGNM=$O(^PSI(58.1,AOU,1,"B",DRGNM)) G:'DRGNM AOU F DRGDA=0:0 S DRGDA=$O(^PSI(58.1,AOU,1,"B",DRGNM,DRGDA)) Q:'DRGDA D BUILD
8 ;
9BUILD I $P(^PSI(58.1,AOU,1,DRGDA,0),"^",10)="Y",$P(^(0),"^",3)="" S $P(^(0),"^",10)=""
10 I $P(^PSI(58.1,AOU,1,DRGDA,0),"^",3)'="" D NOW^%DTC S Y=$P(%,".") Q:$P(^(0),"^",3)'>Y
11 I '$O(^PSI(58.1,AOU,1,DRGDA,2,0)) S K=9999 D SETGL Q
12 F TYP=0:0 S TYP=$O(^PSI(58.1,AOU,1,DRGDA,2,TYP)) Q:'TYP S K=TYP D SETGL
13 Q
14 ;
15SETGL I '$O(^PSDRUG(DRGNM,0)) S DIK="^PSI(58.1,"_AOU_",1,",DA=DRGDA,DA(1)=AOU D ^DIK K DIK Q
16 I $O(^PSDRUG(DRGNM,0)) S DRGNAME=$S($P(^PSDRUG(DRGNM,0),"^")'="":$P(^(0),"^"),1:"Z")
17 S LOCN=$S($P(^PSI(58.1,AOU,1,DRGDA,0),"^",8)'="":$P(^(0),"^",8),1:"Z"),STLEV=$S($P(^(0),"^",2)'="":$P(^(0),"^",2),1:"Z")
18 S RELEV=$S($P(^PSI(58.1,AOU,1,DRGDA,0),"^",11)'="":$P(^(0),"^",11),1:"Z"),MIN=$S(+$P(^(0),"^",12):$P(^(0),"^",12),1:"Z"),EXP="Z" I $D(^PSI(58.1,AOU,1,DRGDA,"EXP")),^("EXP") S EXP=^("EXP")
19 S ^TMP("PSGWSTK",$J,AOU,K,LOCN,DRGNAME,STLEV,RELEV,MIN,EXP)=""
20 Q
21 ;
22PRINT S AOU=0
23AOULP S AOU=$O(^TMP("PSGWSTK",$J,AOU)),TYP=0 G:'AOU DONE D HDR G:OUT END W !,"==> ",$P(^PSI(58.1,AOU,0),"^")
24TYPLP S TYP=$O(^TMP("PSGWSTK",$J,AOU,TYP)),LOCN="" G:'TYP AOULP D:$Y+5>IOSL HDR G:OUT END W !?6,"TYPE: ",$S(TYP=9999:"UNCLASSIFIED BY TYPE",$D(^PSI(58.16,TYP,0)):$P(^(0),"^"),1:"TYPE NAME HAS BEEN DELETED IN FILE 58.16")
25LOCNLP S LOCN=$O(^TMP("PSGWSTK",$J,AOU,TYP,LOCN)),DRGNAME="" G:LOCN="" TYPLP
26DRGLP S DRGNAME=$O(^TMP("PSGWSTK",$J,AOU,TYP,LOCN,DRGNAME)),STLEV="" G:DRGNAME="" LOCNLP
27STLP S STLEV=$O(^TMP("PSGWSTK",$J,AOU,TYP,LOCN,DRGNAME,STLEV)),RELEV="" G:STLEV="" DRGLP
28RELP S RELEV=$O(^TMP("PSGWSTK",$J,AOU,TYP,LOCN,DRGNAME,STLEV,RELEV)),MIN="" G:RELEV="" STLP
29MINLP S MIN=$O(^TMP("PSGWSTK",$J,AOU,TYP,LOCN,DRGNAME,STLEV,RELEV,MIN)),EXP="" G:MIN="" RELP
30EXPLP S EXP=$O(^TMP("PSGWSTK",$J,AOU,TYP,LOCN,DRGNAME,STLEV,RELEV,MIN,EXP)) G:MIN="" MINLP D:$Y+5>IOSL HDR G:OUT END
31 W !?15,$S(LOCN'="Z":LOCN,1:"NOT LISTED"),?30,$S(DRGNAME'="Z":DRGNAME,1:"NAME MISSING"),?74,$S(STLEV'="Z":$J(STLEV,6),1:"NOT LISTED")
32 W ?89,$S(RELEV'="Z":$J(RELEV,6),1:"NOT LISTED"),?106,$S(MIN'="Z":$J(MIN,6),1:"NOT LISTED") I EXP'="Z" S Y=EXP X ^DD("DD")
33 W ?119,$S(EXP'="Z":Y,1:"NOT LISTED") G STLP
34 ;
35DONE I $E(IOST)'="C" W @IOF
36 I $E(IOST)="C" W !!,"Press RETURN to continue: " R AUTO:DTIME
37END K G,IO("Q"),X,Y,ZTSK,^TMP("PSGWSTK",$J),AOU,EXP,DRGDA,DRGNAME,DRGNM,J,JJ,SEL,IGDA,K,LOCN,LN,MIN,PGCT,AOULP,ANS,AOU,RELEV,STLEV,TYP,%,%I,%H,DA,AUTO,OUT D ^%ZISC
38 S:$D(ZTQUEUED) ZTREQ="@" Q
39 ;
40HDR ;PRINT REPORT HEADER
41 I $E(IOST)="C"&(PGCT>1) S DIR(0)="E" D ^DIR K DIR I Y'=1 S OUT=1 Q
42 D NOW^%DTC S Y=$P(%,".") X ^DD("DD") W:$Y @IOF W !,"AOU STOCK LIST BY TYPE/LOCATION"," - DATE: ",Y,?121,"PAGE: ",PGCT I $D(SEL),SEL="I",$D(IGDA) W !,"FOR INVENTORY GROUP - ",$P(^PSI(58.2,IGDA,0),"^")
43 W !!?2,"AREA OF USE",!?10,"TYPE",?104,"MINIMUM QTY",?119,"EXPIRATION",!?15,"LOCATION",?44,"ITEM",?72,"STOCK LEVEL",?87,"REORDER LEVEL",?104,"TO DISPENSE",?122,"DATE",!,LN S PGCT=PGCT+1 Q
Note: See TracBrowser for help on using the repository browser.