| [613] | 1 | PSGWVW ;BHAM ISC/PTD,CML-Lookup Item and List Wards/AOUs Which Stock It ; 29 Dec 93 / 2:31 PM
|
|---|
| 2 | ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
|
|---|
| 3 | W !!,"Using this option, you may look up the wards and/or Areas of Use",!,"which stock the item you select.",!!,"The right margin for this report is 80.",!,"You may queue the report to print at a later time.",!!
|
|---|
| 4 | DIC S DIC="^PSDRUG(",DIC(0)="QEAOM",DIC("A")="Select ITEM Name: " D ^DIC K DIC G:Y<0 END S DRGNUM=+Y
|
|---|
| 5 | K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED." G END
|
|---|
| 6 | DEV I $D(IO("Q")) K IO("Q") S ZTRTN="ENQ^PSGWVW",ZTDESC="Print Ward/AOU List for Item" S ZTSAVE("DRGNUM")=""
|
|---|
| 7 | I D ^%ZTLOAD,HOME^%ZIS K ZTSK G END
|
|---|
| 8 | U IO
|
|---|
| 9 | ENQ ;ENTRY POINT WHEN QUEUED
|
|---|
| 10 | S AOU=0 K ^TMP("PSGWITEM",$J) S $P(LN,"-",80)=""
|
|---|
| 11 | AOULP S AOU=$O(^PSI(58.1,AOU)) G:'AOU PRINT S AOUN=$P(^PSI(58.1,AOU,0),"^") I $D(^PSI(58.1,AOU,"I")),^("I")]"",^("I")'>DT S AOUN=AOUN_"^"_"I"
|
|---|
| 12 | DRGLP I $D(^PSI(58.1,AOU,1,"B",DRGNUM)) D CHKDRG
|
|---|
| 13 | G AOULP
|
|---|
| 14 | ;
|
|---|
| 15 | CHKDRG S DRGDA=0,DRGDA=$O(^PSI(58.1,AOU,1,"B",DRGNUM,DRGDA))
|
|---|
| 16 | I $P(^PSI(58.1,AOU,1,DRGDA,0),"^",10)="Y",$P(^(0),"^",3)="" S $P(^(0),"^",10)=""
|
|---|
| 17 | Q:$P(^PSI(58.1,AOU,1,DRGDA,0),"^",3)'=""
|
|---|
| 18 | S LOCN=$S($P(^PSI(58.1,AOU,1,DRGDA,0),"^",8)'="":$P(^(0),"^",8),1:"NOT LISTED") S STLEV=$S($P(^PSI(58.1,AOU,1,DRGDA,0),"^",2)'="":$P(^(0),"^",2),1:"NOT LISTED")
|
|---|
| 19 | I '$O(^PSI(58.1,AOU,1,DRGDA,4,0)) S WARD=" ",^TMP("PSGWITEM",$J,DRGNUM,WARD,AOUN,LOCN,STLEV)="" Q
|
|---|
| 20 | S WRD=0 F J=0:0 S WRD=$O(^PSI(58.1,AOU,1,DRGDA,4,WRD)) Q:'WRD S WARD=$S($D(^DIC(42,WRD,0)):$P(^(0),"^"),1:"NOT FOUND") S ^TMP("PSGWITEM",$J,DRGNUM,WARD,AOUN,LOCN,STLEV)=""
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | PRINT ;
|
|---|
| 24 | S DRG=0,QFLG="" D HDR1 I '$O(^TMP("PSGWITEM",$J,0)) W !!,$P(^PSDRUG(DRGNUM,0),"^")," is not a Ward Stock/Auto Replenishment item." G DONE
|
|---|
| 25 | LOOP S DRG=$O(^TMP("PSGWITEM",$J,DRG)) G:'DRG MSG G:QFLG END S DRGNAM=$P(^PSDRUG(DRG,0),"^"),WARD="" D HDR2
|
|---|
| 26 | WD S WARD=$O(^TMP("PSGWITEM",$J,DRG,WARD)),AOUN="" G:WARD="" LOOP I $Y+5>IOSL D PRTCHK G:QFLG END W !
|
|---|
| 27 | W WARD
|
|---|
| 28 | AOU S AOUN=$O(^TMP("PSGWITEM",$J,DRG,WARD,AOUN)),LOCN="" G:AOUN="" WD W ?28,$P(AOUN,"^") I $P(AOUN,"^",2)="I" S INACT=1 W " *"
|
|---|
| 29 | LOC S LOCN=$O(^TMP("PSGWITEM",$J,DRG,WARD,AOUN,LOCN)),STLEV="" G:LOCN="" AOU W ?56,LOCN
|
|---|
| 30 | STK S STLEV=$O(^TMP("PSGWITEM",$J,DRG,WARD,AOUN,LOCN,STLEV)) G:STLEV="" LOC W ?70,$S(STLEV'="NOT LISTED":$J(STLEV,4),1:STLEV),!
|
|---|
| 31 | G STK
|
|---|
| 32 | ;
|
|---|
| 33 | MSG I INACT W !!!,"* Indicates AOU is currently Inactive"
|
|---|
| 34 | DONE I $E(IOST)'="C" W @IOF
|
|---|
| 35 | I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
|
|---|
| 36 | END K ANS,QFLG,Y,LN,ZTSK,AOU,AOUN,DRG,DRGDA,DRGNAM,DRGNUM,INACT,J,LOCN,WARD,STLEV,WRD,^TMP("PSGWITEM",$J),IO("Q")
|
|---|
| 37 | D ^%ZISC
|
|---|
| 38 | S:$D(ZTQUEUED) ZTREQ="@" Q
|
|---|
| 39 | HDR1 ;
|
|---|
| 40 | S INACT=0
|
|---|
| 41 | W:$Y @IOF W !,"WARD/AOU LIST FOR AN ITEM",?60,"DATE: " S Y=DT X ^DD("DD") W Y,!,"ITEM NAME",!?70,"STOCK",!?10,"WARD",?35,"AREA OF USE",?56,"LOCATION",?70,"LEVEL",!,LN Q
|
|---|
| 42 | HDR2 W !!,"==>",DRGNAM,!! Q
|
|---|
| 43 | PRTCHK ;
|
|---|
| 44 | I INACT W !!,"* Indicates AOU is currently Inactive"
|
|---|
| 45 | I $E(IOST)="C" W !!,"Press <RETURN> to Continue or ""^"" to Exit: " R ANS:DTIME S:'$T ANS="^" D:ANS?1."?" HELP^PSGWUTL1 I ANS="^" S QFLG=1 Q
|
|---|
| 46 | D HDR1,HDR2 Q
|
|---|
