PRCPRDIS ;WISC/CC-supply station quantity discrepancy report ;4/00
V ;;5.1;IFCAP;**1,24**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
I '$D(PRCP("DPTYPE")) S PRCP("DPTYPE")="S"
D ^PRCPUSEL Q:'$G(PRCP("I"))
I PRCP("DPTYPE")'="S" Q
I $P($G(^PRCP(445,PRCP("I"),5)),"^",1)']"" Q
;
N %,I,INVPT,PRCPINNM,X,XP,XH,Y
S INVPT=PRCP("I"),PRCPINNM=$$INVNAME^PRCPUX1(INVPT)
;
K X S X(1)="This report displays items whose on-hand quantity in "_PRCPINNM_" differs from the supply station's on-hand amount"
D DISPLAY^PRCPUX2(40,79,.X)
;
K X
S Y=$P($G(^PRCP(445,PRCP("I"),6)),"^",1)
I Y']"" S X(1)="No QOH information was ever received. It is recommended you request a QOH update."
I Y]"" D
. X ^DD("DD")
. S I=$P(Y,"@",1),Y=$P(Y,"@",2,99)
. S X(1)="The Last QOH update was received on "_I
. I Y]"" S X(1)=X(1)_" at "_Y_"."
. S X(2)="If this date is too old, you may now request an update."
D DISPLAY^PRCPUX2(2,40,.X)
S XP="Do you want to request a refresh of the supply station QOH"
S XH(1)="Enter YES to request the supply station send a QOH update to GIP,"
S XH(2)="Enter NO to continue with the report using what has already been received,"
S XH(3)="Enter '^' to exit."
S %=$$YN^PRCPUYN(2) I '% Q
I %'=1,%'=2 Q
I %=1 D Q
. W !
. D EN^DDIOL("Sending request...")
. D EN^DDIOL("Please give GIP time to get the information before printing the report.")
. D BLDSEG^PRCPHLQU(INVPT)
;
W ! S %ZIS="Q" D ^%ZIS Q:POP
I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
. S ZTDESC="Item discrepancy report",ZTRTN="PRINT^PRCPRDIS"
. S ZTSAVE("PRCP*")=""
W !!,"<*> please wait <*>"
;
PRINT N %,GIPCNT,INVPT,ITEM,NOW,PAGE,REFILL,SCREEN,SSCNT,X,Y
D NOW^%DTC S Y=% D DD^%DT S NOW=Y
S PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
S INVPT=PRCP("I")
S ITEM=0
F S ITEM=$O(^PRCP(445,INVPT,1,ITEM)) Q:'+ITEM D I $D(PRCPFLAG) Q
. I $P($G(^PRCP(445,INVPT,1,ITEM,0)),"^",9)<1 Q ; not a SS item
. S GIPCNT=$P($G(^PRCP(445,INVPT,1,ITEM,0)),"^",7)
. S SSCNT=$P($G(^PRCP(445,INVPT,1,ITEM,9)),"^",1)
. I 'GIPCNT,'SSCNT Q
. I GIPCNT=SSCNT Q
. I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
. ; W !,$J(ITEM,7)," ",$P($G(^PRCP(445,INVPT,1,ITEM,6)),"^",1)
. ; W !,"GIP: ",$J(GIPCNT,7)," SUPPLY STATION: ",$J(SSCNT,7)
. W $J(GIPCNT,7)," ",$J(SSCNT,7)
. S Y=$P($G(^PRCP(445,INVPT,1,ITEM,9)),"^",2)
. I Y']"" W " "
. I Y]"" D
. . X ^DD("DD")
. . W $J(" ("_Y_")",23)
. W " ",$J(ITEM,7)," ",$E($P($G(^PRCP(445,INVPT,1,ITEM,6)),"^",1),1,32)
. S REFILL=$$REFILLS(ITEM,INVPT) I REFILL]"" W !,?8,REFILL
. W !
;
I '$G(PRCPFLAG) D END^PRCPUREP
D ^%ZISC Q
;
REFILLS(ITEMDA,PRCPINPT) ; is the item refilled in an unposted order
; ITEMDA = DA of item
; PRCPINT = DA of inventory point
;
N ORD,OUTORD,PRIMVN,REFILL,X
S ORD=0,OUTORD=0,REFILL=""
F S ORD=$O(^PRCP(445.3,"AD",PRCPINPT,ORD)) Q:+ORD'>0 D
. S X=^PRCP(445.3,ORD,0)
. I $P(X,"^",10)]"",$P(X,"^",6)="R",$D(^PRCP(445.3,ORD,1,ITEMDA)),($P(X,"^",8))="R" D
. . I $P(^PRCP(445.3,ORD,1,ITEMDA,0),"^",7) D
. . . I OUTORD S REFILL=REFILL_"; "
. . . I 'OUTORD S REFILL=REFILL_"unposted refills: " S OUTORD=1
. . . S REFILL=REFILL_"ORD# "_$P(^PRCP(445.3,ORD,0),"^",1)
. . . S PRIMVN=$P(X,"^",2)_";PRCP(445,"
. . . S X=$$GETVEN^PRCPUVEN(PRCPINPT,ITEMDA,PRIMVN,1)
. . . S X=$P(X,"^",4) ; pkg multiple (conversion factor)
. . . I 'X S X=1
. . . S REFILL=REFILL_"("_($P(^PRCP(445.3,ORD,1,ITEMDA,0),"^",7)*X)_")"
Q REFILL
;
H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
W $C(13),"SUPPLY STATION QUANTITY DISCREPANCY REPORT",?(IOM-$L(%)),%
W !,"FOR: ",PRCPINNM,!
W !,?2,"GIP",?19,"SUPPLY STATION"
W !,"QTY NOW QTY (AS OF DATE and TIME) ITEM NUMBER AND DESCRIPTION"
; W !,"ITEM NUMBER AND DESCRIPTION"
; W ?58,$J("STAND",6),$J("NORM",6),$J("UNIT",10),!,"DESCRIPTION",?29,"MI#",?35,"NSN",?50,$J("UNIT/IS",8),$J("REOPT",6),$J("STLVL",6),$J("COST",10)
S %="",$P(%,"-",IOM+1)="" W !,%,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRDIS 4064 printed Dec 13, 2024@02:14:49 Page 2
PRCPRDIS ;WISC/CC-supply station quantity discrepancy report ;4/00
V ;;5.1;IFCAP;**1,24**;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 IF '$DATA(PRCP("DPTYPE"))
SET PRCP("DPTYPE")="S"
+3 DO ^PRCPUSEL
if '$GET(PRCP("I"))
QUIT
+4 IF PRCP("DPTYPE")'="S"
QUIT
+5 IF $PIECE($GET(^PRCP(445,PRCP("I"),5)),"^",1)']""
QUIT
+6 ;
+7 NEW %,I,INVPT,PRCPINNM,X,XP,XH,Y
+8 SET INVPT=PRCP("I")
SET PRCPINNM=$$INVNAME^PRCPUX1(INVPT)
+9 ;
+10 KILL X
SET X(1)="This report displays items whose on-hand quantity in "_PRCPINNM_" differs from the supply station's on-hand amount"
+11 DO DISPLAY^PRCPUX2(40,79,.X)
+12 ;
+13 KILL X
+14 SET Y=$PIECE($GET(^PRCP(445,PRCP("I"),6)),"^",1)
+15 IF Y']""
SET X(1)="No QOH information was ever received. It is recommended you request a QOH update."
+16 IF Y]""
Begin DoDot:1
+17 XECUTE ^DD("DD")
+18 SET I=$PIECE(Y,"@",1)
SET Y=$PIECE(Y,"@",2,99)
+19 SET X(1)="The Last QOH update was received on "_I
+20 IF Y]""
SET X(1)=X(1)_" at "_Y_"."
+21 SET X(2)="If this date is too old, you may now request an update."
End DoDot:1
+22 DO DISPLAY^PRCPUX2(2,40,.X)
+23 SET XP="Do you want to request a refresh of the supply station QOH"
+24 SET XH(1)="Enter YES to request the supply station send a QOH update to GIP,"
+25 SET XH(2)="Enter NO to continue with the report using what has already been received,"
+26 SET XH(3)="Enter '^' to exit."
+27 SET %=$$YN^PRCPUYN(2)
IF '%
QUIT
+28 IF %'=1
IF %'=2
QUIT
+29 IF %=1
Begin DoDot:1
+30 WRITE !
+31 DO EN^DDIOL("Sending request...")
+32 DO EN^DDIOL("Please give GIP time to get the information before printing the report.")
+33 DO BLDSEG^PRCPHLQU(INVPT)
End DoDot:1
QUIT
+34 ;
+35 WRITE !
SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
+36 IF $DATA(IO("Q"))
Begin DoDot:1
+37 SET ZTDESC="Item discrepancy report"
SET ZTRTN="PRINT^PRCPRDIS"
+38 SET ZTSAVE("PRCP*")=""
End DoDot:1
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
QUIT
+39 WRITE !!,"<*> please wait <*>"
+40 ;
PRINT NEW %,GIPCNT,INVPT,ITEM,NOW,PAGE,REFILL,SCREEN,SSCNT,X,Y
+1 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET NOW=Y
+2 SET PAGE=1
SET SCREEN=$$SCRPAUSE^PRCPUREP
USE IO
DO H
+3 SET INVPT=PRCP("I")
+4 SET ITEM=0
+5 FOR
SET ITEM=$ORDER(^PRCP(445,INVPT,1,ITEM))
if '+ITEM
QUIT
Begin DoDot:1
+6 ; not a SS item
IF $PIECE($GET(^PRCP(445,INVPT,1,ITEM,0)),"^",9)<1
QUIT
+7 SET GIPCNT=$PIECE($GET(^PRCP(445,INVPT,1,ITEM,0)),"^",7)
+8 SET SSCNT=$PIECE($GET(^PRCP(445,INVPT,1,ITEM,9)),"^",1)
+9 IF 'GIPCNT
IF 'SSCNT
QUIT
+10 IF GIPCNT=SSCNT
QUIT
+11 IF $Y>(IOSL-4)
if SCREEN
DO P^PRCPUREP
if $DATA(PRCPFLAG)
QUIT
DO H
+12 ; W !,$J(ITEM,7)," ",$P($G(^PRCP(445,INVPT,1,ITEM,6)),"^",1)
+13 ; W !,"GIP: ",$J(GIPCNT,7)," SUPPLY STATION: ",$J(SSCNT,7)
+14 WRITE $JUSTIFY(GIPCNT,7)," ",$JUSTIFY(SSCNT,7)
+15 SET Y=$PIECE($GET(^PRCP(445,INVPT,1,ITEM,9)),"^",2)
+16 IF Y']""
WRITE " "
+17 IF Y]""
Begin DoDot:2
+18 XECUTE ^DD("DD")
+19 WRITE $JUSTIFY(" ("_Y_")",23)
End DoDot:2
+20 WRITE " ",$JUSTIFY(ITEM,7)," ",$EXTRACT($PIECE($GET(^PRCP(445,INVPT,1,ITEM,6)),"^",1),1,32)
+21 SET REFILL=$$REFILLS(ITEM,INVPT)
IF REFILL]""
WRITE !,?8,REFILL
+22 WRITE !
End DoDot:1
IF $DATA(PRCPFLAG)
QUIT
+23 ;
+24 IF '$GET(PRCPFLAG)
DO END^PRCPUREP
+25 DO ^%ZISC
QUIT
+26 ;
REFILLS(ITEMDA,PRCPINPT) ; is the item refilled in an unposted order
+1 ; ITEMDA = DA of item
+2 ; PRCPINT = DA of inventory point
+3 ;
+4 NEW ORD,OUTORD,PRIMVN,REFILL,X
+5 SET ORD=0
SET OUTORD=0
SET REFILL=""
+6 FOR
SET ORD=$ORDER(^PRCP(445.3,"AD",PRCPINPT,ORD))
if +ORD'>0
QUIT
Begin DoDot:1
+7 SET X=^PRCP(445.3,ORD,0)
+8 IF $PIECE(X,"^",10)]""
IF $PIECE(X,"^",6)="R"
IF $DATA(^PRCP(445.3,ORD,1,ITEMDA))
IF ($PIECE(X,"^",8))="R"
Begin DoDot:2
+9 IF $PIECE(^PRCP(445.3,ORD,1,ITEMDA,0),"^",7)
Begin DoDot:3
+10 IF OUTORD
SET REFILL=REFILL_"; "
+11 IF 'OUTORD
SET REFILL=REFILL_"unposted refills: "
SET OUTORD=1
+12 SET REFILL=REFILL_"ORD# "_$PIECE(^PRCP(445.3,ORD,0),"^",1)
+13 SET PRIMVN=$PIECE(X,"^",2)_";PRCP(445,"
+14 SET X=$$GETVEN^PRCPUVEN(PRCPINPT,ITEMDA,PRIMVN,1)
+15 ; pkg multiple (conversion factor)
SET X=$PIECE(X,"^",4)
+16 IF 'X
SET X=1
+17 SET REFILL=REFILL_"("_($PIECE(^PRCP(445.3,ORD,1,ITEMDA,0),"^",7)*X)_")"
End DoDot:3
End DoDot:2
End DoDot:1
+18 QUIT REFILL
+19 ;
H SET %=NOW_" PAGE "_PAGE
SET PAGE=PAGE+1
IF PAGE'=2!(SCREEN)
WRITE @IOF
+1 WRITE $CHAR(13),"SUPPLY STATION QUANTITY DISCREPANCY REPORT",?(IOM-$LENGTH(%)),%
+2 WRITE !,"FOR: ",PRCPINNM,!
+3 WRITE !,?2,"GIP",?19,"SUPPLY STATION"
+4 WRITE !,"QTY NOW QTY (AS OF DATE and TIME) ITEM NUMBER AND DESCRIPTION"
+5 ; W !,"ITEM NUMBER AND DESCRIPTION"
+6 ; W ?58,$J("STAND",6),$J("NORM",6),$J("UNIT",10),!,"DESCRIPTION",?29,"MI#",?35,"NSN",?50,$J("UNIT/IS",8),$J("REOPT",6),$J("STLVL",6),$J("COST",10)
+7 SET %=""
SET $PIECE(%,"-",IOM+1)=""
WRITE !,%,!
+8 QUIT
