source: WorldVistAEHR/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWVW.m@ 975

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1PSGWVW ;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.",!!
4DIC 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
6DEV 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
9ENQ ;ENTRY POINT WHEN QUEUED
10 S AOU=0 K ^TMP("PSGWITEM",$J) S $P(LN,"-",80)=""
11AOULP 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"
12DRGLP I $D(^PSI(58.1,AOU,1,"B",DRGNUM)) D CHKDRG
13 G AOULP
14 ;
15CHKDRG 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 ;
23PRINT ;
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
25LOOP S DRG=$O(^TMP("PSGWITEM",$J,DRG)) G:'DRG MSG G:QFLG END S DRGNAM=$P(^PSDRUG(DRG,0),"^"),WARD="" D HDR2
26WD 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
28AOU 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 " *"
29LOC S LOCN=$O(^TMP("PSGWITEM",$J,DRG,WARD,AOUN,LOCN)),STLEV="" G:LOCN="" AOU W ?56,LOCN
30STK 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 ;
33MSG I INACT W !!!,"* Indicates AOU is currently Inactive"
34DONE I $E(IOST)'="C" W @IOF
35 I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
36END 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
39HDR1 ;
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
42HDR2 W !!,"==>",DRGNAM,!! Q
43PRTCHK ;
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
Note: See TracBrowser for help on using the repository browser.