- PSGWDUP1 ;BHAM ISC/KKA-Report for Duplicate Entries in ITEM subfile-CONTINUED ; 17 Aug 93 / 10:58 AM
- ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- ENTRY ;** entry point when queued **
- S (PAGE,OUT)=0
- S CONT="********** CONTINUED **********",CONTLTH=(132-$L(CONT))/2
- S CNT=1 F Q:'$P(PSGWDRP,",",CNT)!(OUT) S PSGWDRCT=$P(PSGWDRP,",",CNT),CNT=CNT+1 D ONE
- I $E(IOST)'="P",'OUT W !!,"Press RETURN to continue: " R CONT:DTIME
- END W !,@IOF
- 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
- Q
- ONE ;** display information for one drug **
- F PSGWNXT=0:0 S PSGWNXT=$O(^TMP("PSGW",$J,PSGWDRCT,PSGWNXT)) Q:'PSGWNXT!(OUT) S PSGWND=^(PSGWNXT) D
- .S PSGWAOU=$P(PSGWND,"^"),PSGWITM=$P(PSGWND,"^",2),PSGWDRG=$P(PSGWND,"^",3)
- .D PAGE
- .D INV,RET:'OUT,OD:'OUT
- Q
- INV ;** display inventory data **
- I '$O(^PSI(58.1,PSGWAOU,1,PSGWITM,1,0)) W !,"INVENTORIES:",!,?10,"No inventories shown" Q
- D INVHEAD
- F PSGWINV=0:0 S PSGWINV=$O(^PSI(58.1,PSGWAOU,1,PSGWITM,1,PSGWINV)) Q:'PSGWINV!(OUT) D
- .I $Y+6>IOSL D PAGE Q:OUT W !,?CONTLTH,CONT D INVHEAD
- .S PSGWINND=$G(^PSI(58.1,PSGWAOU,1,PSGWITM,1,PSGWINV,0))
- .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)
- Q
- INVHEAD ;** header for inventory data **
- W !,"INVENTORIES: "
- W !!,?10,"DATE/TIME",?33,"COMPILED",?60,!,?13,"FOR",?35,"INTO",?45,"DISPENSE",!,?10,"INVENTORY",?35,"AMIS",?45,"QUANTITY",?60,"ON HAND",!
- W ?10 F I=1:1:122 W "-"
- Q
- RET ;** display return data **
- I $Y+6>IOSL D PAGE Q:OUT W !,?CONTLTH,CONT
- I '$O(^PSI(58.1,PSGWAOU,1,PSGWITM,3,0)) W !!,"RETURNS:",!,?10,"No returns shown" Q
- D RETHEAD
- F PSGWRET=0:0 S PSGWRET=$O(^PSI(58.1,PSGWAOU,1,PSGWITM,3,PSGWRET)) Q:'PSGWRET!(OUT) D
- .I $Y+6>IOSL D PAGE Q:OUT W !,?CONTLTH,CONT D RETHEAD
- .S PSGWRTND=$G(^PSI(58.1,PSGWAOU,1,PSGWITM,3,PSGWRET,0))
- .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")
- .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,!
- Q
- RETHEAD ;** header for return data **
- W !!,"RETURNS: "
- W !!,?35,"COMPILED",!,?10,"DATE OF",?25,"RETURN",?37,"INTO",?50,"RETURN",!,?10,"RETURN",?25,"QUANTITY",?37,"AMIS",?50,"REASON(S)",!
- W ?10 F I=1:1:122 W "-"
- Q
- OD ;** display on-demand data **
- I $Y+6>IOSL D PAGE Q:OUT W !,?CONTLTH,CONT
- I '$O(^PSI(58.1,PSGWAOU,1,PSGWITM,5,0)) W !!,"ON-DEMANDS: ",!,?10,"No on-demands shown" Q
- D ODHEAD
- F PSGWOD=0:0 S PSGWOD=$O(^PSI(58.1,PSGWAOU,1,PSGWITM,5,PSGWOD)) Q:'PSGWOD!(OUT) D
- .I $Y+6>IOSL D PAGE Q:OUT W !,?CONTLTH,CONT D ODHEAD
- .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:"")
- .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
- Q
- ODHEAD ;** header for on-demand data **
- W !!,"ON-DEMANDS:"
- 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"
- W !,?10 F I=1:1:122 W "-"
- Q
- PAGE ;** header for page **
- I PAGE>0,($E(IOST)'="P") W !!,"Press RETURN to continue or ""^"" to quit: " R CONT:DTIME S:CONT["^" OUT=1 Q:'$T!(OUT)
- S PAGE=PAGE+1
- W:$Y @IOF S X="*** DUPLICATE ENTRY REPORT ***" W !!,?(132-$L(X))/2,X,!!,"DRUG: ",$P($G(^PSDRUG(PSGWDRG,0)),"^"),?115,"PAGE ",PAGE
- W !!!,"AOU: ",$P($G(^PSI(58.1,PSGWAOU,0)),"^"),!,"Internal Entry #: ",PSGWITM,!,"Pointer in file 50: ",PSGWDRG,!
- F I=1:1:132 W "-"
- PSGWDUP1 ;BHAM ISC/KKA-Report for Duplicate Entries in ITEM subfile-CONTINUED ; 17 Aug 93 / 10:58 AM
- +1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- ENTRY ;** entry point when queued **
- +1 SET (PAGE,OUT)=0
- +2 SET CONT="********** CONTINUED **********"
- SET CONTLTH=(132-$LENGTH(CONT))/2
- +3 SET CNT=1
- FOR
- IF '$PIECE(PSGWDRP,",",CNT)!(OUT)
- QUIT
- SET PSGWDRCT=$PIECE(PSGWDRP,",",CNT)
- SET CNT=CNT+1
- DO ONE
- +4 IF $EXTRACT(IOST)'="P"
- IF 'OUT
- WRITE !!,"Press RETURN to continue: "
- READ CONT:DTIME
- END WRITE !,@IOF
- +1 KILL 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
- +2 QUIT
- ONE ;** display information for one drug **
- +1 FOR PSGWNXT=0:0
- SET PSGWNXT=$ORDER(^TMP("PSGW",$JOB,PSGWDRCT,PSGWNXT))
- IF 'PSGWNXT!(OUT)
- QUIT
- SET PSGWND=^(PSGWNXT)
- Begin DoDot:1
- +2 SET PSGWAOU=$PIECE(PSGWND,"^")
- SET PSGWITM=$PIECE(PSGWND,"^",2)
- SET PSGWDRG=$PIECE(PSGWND,"^",3)
- +3 DO PAGE
- +4 DO INV
- IF 'OUT
- DO RET
- IF 'OUT
- DO OD
- End DoDot:1
- +5 QUIT
- INV ;** display inventory data **
- +1 IF '$ORDER(^PSI(58.1,PSGWAOU,1,PSGWITM,1,0))
- WRITE !,"INVENTORIES:",!,?10,"No inventories shown"
- QUIT
- +2 DO INVHEAD
- +3 FOR PSGWINV=0:0
- SET PSGWINV=$ORDER(^PSI(58.1,PSGWAOU,1,PSGWITM,1,PSGWINV))
- IF 'PSGWINV!(OUT)
- QUIT
- Begin DoDot:1
- +4 IF $Y+6>IOSL
- DO PAGE
- IF OUT
- QUIT
- WRITE !,?CONTLTH,CONT
- DO INVHEAD
- +5 SET PSGWINND=$GET(^PSI(58.1,PSGWAOU,1,PSGWITM,1,PSGWINV,0))
- +6 IF PSGWINND]""
- SET Y=$PIECE($GET(^PSI(58.19,+$PIECE(PSGWINND,"^"),0)),"^")
- XECUTE ^DD("DD")
- WRITE !,?10,Y,?35,$SELECT($PIECE(PSGWINND,"^",4)=1:"YES",1:"NO"),?47,$PIECE(PSGWINND,"^",5),?62,$PIECE(PSGWINND,"^",6)
- End DoDot:1
- +7 QUIT
- INVHEAD ;** header for inventory data **
- +1 WRITE !,"INVENTORIES: "
- +2 WRITE !!,?10,"DATE/TIME",?33,"COMPILED",?60,!,?13,"FOR",?35,"INTO",?45,"DISPENSE",!,?10,"INVENTORY",?35,"AMIS",?45,"QUANTITY",?60,"ON HAND",!
- +3 WRITE ?10
- FOR I=1:1:122
- WRITE "-"
- +4 QUIT
- RET ;** display return data **
- +1 IF $Y+6>IOSL
- DO PAGE
- IF OUT
- QUIT
- WRITE !,?CONTLTH,CONT
- +2 IF '$ORDER(^PSI(58.1,PSGWAOU,1,PSGWITM,3,0))
- WRITE !!,"RETURNS:",!,?10,"No returns shown"
- QUIT
- +3 DO RETHEAD
- +4 FOR PSGWRET=0:0
- SET PSGWRET=$ORDER(^PSI(58.1,PSGWAOU,1,PSGWITM,3,PSGWRET))
- IF 'PSGWRET!(OUT)
- QUIT
- Begin DoDot:1
- +5 IF $Y+6>IOSL
- DO PAGE
- IF OUT
- QUIT
- WRITE !,?CONTLTH,CONT
- DO RETHEAD
- +6 SET PSGWRTND=$GET(^PSI(58.1,PSGWAOU,1,PSGWITM,3,PSGWRET,0))
- +7 IF PSGWRTND]""
- SET Y=$PIECE(PSGWRTND,"^")
- XECUTE ^DD("DD")
- WRITE !,?10,Y,?27,$PIECE(PSGWRTND,"^",2),?37,$SELECT($PIECE(PSGWRTND,"^",4)=1:"YES",1:"NO")
- +8 FOR PSGWRR=0:0
- SET PSGWRR=$ORDER(^PSI(58.1,PSGWAOU,1,PSGWITM,3,PSGWRET,1,PSGWRR))
- IF 'PSGWRR
- QUIT
- SET Y=$PIECE(^(PSGWRR,0),"^")
- SET C=$PIECE(^DD(58.152,.01,0),"^",2)
- DO Y^DIQ
- WRITE ?50,Y,!
- End DoDot:1
- +9 QUIT
- RETHEAD ;** header for return data **
- +1 WRITE !!,"RETURNS: "
- +2 WRITE !!,?35,"COMPILED",!,?10,"DATE OF",?25,"RETURN",?37,"INTO",?50,"RETURN",!,?10,"RETURN",?25,"QUANTITY",?37,"AMIS",?50,"REASON(S)",!
- +3 WRITE ?10
- FOR I=1:1:122
- WRITE "-"
- +4 QUIT
- OD ;** display on-demand data **
- +1 IF $Y+6>IOSL
- DO PAGE
- IF OUT
- QUIT
- WRITE !,?CONTLTH,CONT
- +2 IF '$ORDER(^PSI(58.1,PSGWAOU,1,PSGWITM,5,0))
- WRITE !!,"ON-DEMANDS: ",!,?10,"No on-demands shown"
- QUIT
- +3 DO ODHEAD
- +4 FOR PSGWOD=0:0
- SET PSGWOD=$ORDER(^PSI(58.1,PSGWAOU,1,PSGWITM,5,PSGWOD))
- IF 'PSGWOD!(OUT)
- QUIT
- Begin DoDot:1
- +5 IF $Y+6>IOSL
- DO PAGE
- IF OUT
- QUIT
- WRITE !,?CONTLTH,CONT
- DO ODHEAD
- +6 SET PSGWODND=$GET(^PSI(58.1,PSGWAOU,1,PSGWITM,5,PSGWOD,0))
- IF PSGWODND
- SET Y=$PIECE(PSGWODND,"^")
- XECUTE ^DD("DD")
- WRITE !,?10,Y,?30,$PIECE(PSGWODND,"^",2),?50,$SELECT($PIECE(PSGWODND,"^",3):$PIECE($GET(^VA(200,$PIECE(PSGWODND,"^",3),0)),"^"),1:"")
- +7 IF PSGWODND]""
- WRITE ?72,$SELECT($PIECE(PSGWODND,"^",4)=1:"YES",1:"NO"),?85,$SELECT($PIECE(PSGWODND,"^",5):$PIECE($GET(^VA(200,+$PIECE(PSGWODND,"^",5),0)),"^"),1:"")
- SET Y=$PIECE(PSGWODND,"^",6)
- XECUTE ^DD("DD")
- WRITE ?105,Y
- End DoDot:1
- +8 QUIT
- ODHEAD ;** header for on-demand data **
- +1 WRITE !!,"ON-DEMANDS:"
- +2 WRITE !!,?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"
- +3 WRITE !,?10
- FOR I=1:1:122
- WRITE "-"
- +4 QUIT
- PAGE ;** header for page **
- +1 IF PAGE>0
- IF ($EXTRACT(IOST)'="P")
- WRITE !!,"Press RETURN to continue or ""^"" to quit: "
- READ CONT:DTIME
- IF CONT["^"
- SET OUT=1
- IF '$TEST!(OUT)
- QUIT
- +2 SET PAGE=PAGE+1
- +3 IF $Y
- WRITE @IOF
- SET X="*** DUPLICATE ENTRY REPORT ***"
- WRITE !!,?(132-$LENGTH(X))/2,X,!!,"DRUG: ",$PIECE($GET(^PSDRUG(PSGWDRG,0)),"^"),?115,"PAGE ",PAGE
- +4 WRITE !!!,"AOU: ",$PIECE($GET(^PSI(58.1,PSGWAOU,0)),"^"),!,"Internal Entry #: ",PSGWITM,!,"Pointer in file 50: ",PSGWDRG,!
- +5 FOR I=1:1:132
- WRITE "-"