44 lines
3.2 KiB
Mathematica
44 lines
3.2 KiB
Mathematica
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
|