source: WorldVistAEHR/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWLSI1.m@ 1076

PSGWLSI1 ;BHAM ISC/PTD,CML-Print Stock Items in Order by Type/Location ; 03 Sep 93 / 9:35 AM
 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
ENQ ;ENTRY POINT WHEN QUEUED
 K ^TMP("PSGWSTK",$J) S PGCT=1,$P(LN,"-",132)="",AOU=0,OUT=0
AOU S AOU=$O(AOULP(AOU)) G:'AOU PRINT
 ;
XREF 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
 ;
BUILD I $P(^PSI(58.1,AOU,1,DRGDA,0),"^",10)="Y",$P(^(0),"^",3)="" S $P(^(0),"^",10)=""
 I $P(^PSI(58.1,AOU,1,DRGDA,0),"^",3)'="" D NOW^%DTC S Y=$P(%,".") Q:$P(^(0),"^",3)'>Y
 I '$O(^PSI(58.1,AOU,1,DRGDA,2,0)) S K=9999 D SETGL Q
 F TYP=0:0 S TYP=$O(^PSI(58.1,AOU,1,DRGDA,2,TYP)) Q:'TYP  S K=TYP D SETGL
 Q
 ;
SETGL I '$O(^PSDRUG(DRGNM,0)) S DIK="^PSI(58.1,"_AOU_",1,",DA=DRGDA,DA(1)=AOU D ^DIK K DIK Q
 I $O(^PSDRUG(DRGNM,0)) S DRGNAME=$S($P(^PSDRUG(DRGNM,0),"^")'="":$P(^(0),"^"),1:"Z")
 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")
 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")
 S ^TMP("PSGWSTK",$J,AOU,K,LOCN,DRGNAME,STLEV,RELEV,MIN,EXP)=""
 Q
 ;
PRINT S AOU=0
AOULP S AOU=$O(^TMP("PSGWSTK",$J,AOU)),TYP=0 G:'AOU DONE D HDR G:OUT END W !,"==> ",$P(^PSI(58.1,AOU,0),"^")
TYPLP 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")
LOCNLP S LOCN=$O(^TMP("PSGWSTK",$J,AOU,TYP,LOCN)),DRGNAME="" G:LOCN="" TYPLP
DRGLP S DRGNAME=$O(^TMP("PSGWSTK",$J,AOU,TYP,LOCN,DRGNAME)),STLEV="" G:DRGNAME="" LOCNLP
STLP S STLEV=$O(^TMP("PSGWSTK",$J,AOU,TYP,LOCN,DRGNAME,STLEV)),RELEV="" G:STLEV="" DRGLP
RELP S RELEV=$O(^TMP("PSGWSTK",$J,AOU,TYP,LOCN,DRGNAME,STLEV,RELEV)),MIN="" G:RELEV="" STLP
MINLP S MIN=$O(^TMP("PSGWSTK",$J,AOU,TYP,LOCN,DRGNAME,STLEV,RELEV,MIN)),EXP="" G:MIN="" RELP
EXPLP 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
 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")
 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")
 W ?119,$S(EXP'="Z":Y,1:"NOT LISTED") G STLP
 ;
DONE I $E(IOST)'="C" W @IOF
 I $E(IOST)="C" W !!,"Press RETURN to continue: " R AUTO:DTIME
END 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
 S:$D(ZTQUEUED) ZTREQ="@" Q
 ;
HDR ;PRINT REPORT HEADER
 I $E(IOST)="C"&(PGCT>1) S DIR(0)="E" D ^DIR K DIR I Y'=1 S OUT=1 Q
 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),"^")
 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