source: WorldVistAEHR/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWDUP1.m@ 691

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

initial load of WorldVistAEHR

File size: 3.8 KB
RevLine 
[613]1PSGWDUP1 ;BHAM ISC/KKA-Report for Duplicate Entries in ITEM subfile-CONTINUED ; 17 Aug 93 / 10:58 AM
2 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
3ENTRY ;** entry point when queued **
4 S (PAGE,OUT)=0
5 S CONT="********** CONTINUED **********",CONTLTH=(132-$L(CONT))/2
6 S CNT=1 F Q:'$P(PSGWDRP,",",CNT)!(OUT) S PSGWDRCT=$P(PSGWDRP,",",CNT),CNT=CNT+1 D ONE
7 I $E(IOST)'="P",'OUT W !!,"Press RETURN to continue: " R CONT:DTIME
8END W !,@IOF
9 K CNT,CNT3,CONT,CONTLTH,I,OUT,PAGE,PSGWAOU,PSGWDRCT,PSGWDRG,PSGWDRP,PSGWINND,PSGWINV,PSGWITM,PSGWND,PSGWNOD,PSGWNXT,PSGWOD,PSGWODND,PSGWRET,PSGWRR,PSGWRTND,PSGWVAL,PSGWY,X,Y
10 Q
11ONE ;** display information for one drug **
12 F PSGWNXT=0:0 S PSGWNXT=$O(^TMP("PSGW",$J,PSGWDRCT,PSGWNXT)) Q:'PSGWNXT!(OUT) S PSGWND=^(PSGWNXT) D
13 .S PSGWAOU=$P(PSGWND,"^"),PSGWITM=$P(PSGWND,"^",2),PSGWDRG=$P(PSGWND,"^",3)
14 .D PAGE
15 .D INV,RET:'OUT,OD:'OUT
16 Q
17INV ;** display inventory data **
18 I '$O(^PSI(58.1,PSGWAOU,1,PSGWITM,1,0)) W !,"INVENTORIES:",!,?10,"No inventories shown" Q
19 D INVHEAD
20 F PSGWINV=0:0 S PSGWINV=$O(^PSI(58.1,PSGWAOU,1,PSGWITM,1,PSGWINV)) Q:'PSGWINV!(OUT) D
21 .I $Y+6>IOSL D PAGE Q:OUT W !,?CONTLTH,CONT D INVHEAD
22 .S PSGWINND=$G(^PSI(58.1,PSGWAOU,1,PSGWITM,1,PSGWINV,0))
23 .I PSGWINND]"" S Y=$P($G(^PSI(58.19,+$P(PSGWINND,"^"),0)),"^") X ^DD("DD") W !,?10,Y,?35,$S($P(PSGWINND,"^",4)=1:"YES",1:"NO"),?47,$P(PSGWINND,"^",5),?62,$P(PSGWINND,"^",6)
24 Q
25INVHEAD ;** header for inventory data **
26 W !,"INVENTORIES: "
27 W !!,?10,"DATE/TIME",?33,"COMPILED",?60,!,?13,"FOR",?35,"INTO",?45,"DISPENSE",!,?10,"INVENTORY",?35,"AMIS",?45,"QUANTITY",?60,"ON HAND",!
28 W ?10 F I=1:1:122 W "-"
29 Q
30RET ;** display return data **
31 I $Y+6>IOSL D PAGE Q:OUT W !,?CONTLTH,CONT
32 I '$O(^PSI(58.1,PSGWAOU,1,PSGWITM,3,0)) W !!,"RETURNS:",!,?10,"No returns shown" Q
33 D RETHEAD
34 F PSGWRET=0:0 S PSGWRET=$O(^PSI(58.1,PSGWAOU,1,PSGWITM,3,PSGWRET)) Q:'PSGWRET!(OUT) D
35 .I $Y+6>IOSL D PAGE Q:OUT W !,?CONTLTH,CONT D RETHEAD
36 .S PSGWRTND=$G(^PSI(58.1,PSGWAOU,1,PSGWITM,3,PSGWRET,0))
37 .I PSGWRTND]"" S Y=$P(PSGWRTND,"^") X ^DD("DD") W !,?10,Y,?27,$P(PSGWRTND,"^",2),?37,$S($P(PSGWRTND,"^",4)=1:"YES",1:"NO")
38 .F PSGWRR=0:0 S PSGWRR=$O(^PSI(58.1,PSGWAOU,1,PSGWITM,3,PSGWRET,1,PSGWRR)) Q:'PSGWRR S Y=$P(^(PSGWRR,0),"^"),C=$P(^DD(58.152,.01,0),"^",2) D Y^DIQ W ?50,Y,!
39 Q
40RETHEAD ;** header for return data **
41 W !!,"RETURNS: "
42 W !!,?35,"COMPILED",!,?10,"DATE OF",?25,"RETURN",?37,"INTO",?50,"RETURN",!,?10,"RETURN",?25,"QUANTITY",?37,"AMIS",?50,"REASON(S)",!
43 W ?10 F I=1:1:122 W "-"
44 Q
45OD ;** display on-demand data **
46 I $Y+6>IOSL D PAGE Q:OUT W !,?CONTLTH,CONT
47 I '$O(^PSI(58.1,PSGWAOU,1,PSGWITM,5,0)) W !!,"ON-DEMANDS: ",!,?10,"No on-demands shown" Q
48 D ODHEAD
49 F PSGWOD=0:0 S PSGWOD=$O(^PSI(58.1,PSGWAOU,1,PSGWITM,5,PSGWOD)) Q:'PSGWOD!(OUT) D
50 .I $Y+6>IOSL D PAGE Q:OUT W !,?CONTLTH,CONT D ODHEAD
51 .S PSGWODND=$G(^PSI(58.1,PSGWAOU,1,PSGWITM,5,PSGWOD,0)) I PSGWODND S Y=$P(PSGWODND,"^") X ^DD("DD") W !,?10,Y,?30,$P(PSGWODND,"^",2),?50,$S($P(PSGWODND,"^",3):$P($G(^VA(200,$P(PSGWODND,"^",3),0)),"^"),1:"")
52 .I PSGWODND]"" W ?72,$S($P(PSGWODND,"^",4)=1:"YES",1:"NO"),?85,$S($P(PSGWODND,"^",5):$P($G(^VA(200,+$P(PSGWODND,"^",5),0)),"^"),1:"") S Y=$P(PSGWODND,"^",6) X ^DD("DD") W ?105,Y
53 Q
54ODHEAD ;** header for on-demand data **
55 W !!,"ON-DEMANDS:"
56 W !!,?70,"COMPILED",!,?10,"DATE/TIME",?30,"QUANTITY",?72,"INTO",?105,"DATE/TIME",!,?10,"FOR ON-DEMAND",?30,"DISPENSED",?50,"ENTERED BY",?72,"AMIS",?85,"EDITED BY",?105,"LAST EDITED"
57 W !,?10 F I=1:1:122 W "-"
58 Q
59PAGE ;** header for page **
60 I PAGE>0,($E(IOST)'="P") W !!,"Press RETURN to continue or ""^"" to quit: " R CONT:DTIME S:CONT["^" OUT=1 Q:'$T!(OUT)
61 S PAGE=PAGE+1
62 W:$Y @IOF S X="*** DUPLICATE ENTRY REPORT ***" W !!,?(132-$L(X))/2,X,!!,"DRUG: ",$P($G(^PSDRUG(PSGWDRG,0)),"^"),?115,"PAGE ",PAGE
63 W !!!,"AOU: ",$P($G(^PSI(58.1,PSGWAOU,0)),"^"),!,"Internal Entry #: ",PSGWITM,!,"Pointer in file 50: ",PSGWDRG,!
64 F I=1:1:132 W "-"
Note: See TracBrowser for help on using the repository browser.