| [613] | 1 | PSGWLSI1 ;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
|
|---|
| 3 | ENQ ;ENTRY POINT WHEN QUEUED
|
|---|
| 4 | K ^TMP("PSGWSTK",$J) S PGCT=1,$P(LN,"-",132)="",AOU=0,OUT=0
|
|---|
| 5 | AOU S AOU=$O(AOULP(AOU)) G:'AOU PRINT
|
|---|
| 6 | ;
|
|---|
| 7 | 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
|
|---|
| 8 | ;
|
|---|
| 9 | BUILD 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 | ;
|
|---|
| 15 | SETGL 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 | ;
|
|---|
| 22 | PRINT S AOU=0
|
|---|
| 23 | 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),"^")
|
|---|
| 24 | 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")
|
|---|
| 25 | LOCNLP S LOCN=$O(^TMP("PSGWSTK",$J,AOU,TYP,LOCN)),DRGNAME="" G:LOCN="" TYPLP
|
|---|
| 26 | DRGLP S DRGNAME=$O(^TMP("PSGWSTK",$J,AOU,TYP,LOCN,DRGNAME)),STLEV="" G:DRGNAME="" LOCNLP
|
|---|
| 27 | STLP S STLEV=$O(^TMP("PSGWSTK",$J,AOU,TYP,LOCN,DRGNAME,STLEV)),RELEV="" G:STLEV="" DRGLP
|
|---|
| 28 | RELP S RELEV=$O(^TMP("PSGWSTK",$J,AOU,TYP,LOCN,DRGNAME,STLEV,RELEV)),MIN="" G:RELEV="" STLP
|
|---|
| 29 | MINLP S MIN=$O(^TMP("PSGWSTK",$J,AOU,TYP,LOCN,DRGNAME,STLEV,RELEV,MIN)),EXP="" G:MIN="" RELP
|
|---|
| 30 | 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
|
|---|
| 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 | ;
|
|---|
| 35 | DONE I $E(IOST)'="C" W @IOF
|
|---|
| 36 | I $E(IOST)="C" W !!,"Press RETURN to continue: " R AUTO:DTIME
|
|---|
| 37 | 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
|
|---|
| 38 | S:$D(ZTQUEUED) ZTREQ="@" Q
|
|---|
| 39 | ;
|
|---|
| 40 | HDR ;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
|
|---|
