PRCPRPK2 ;WISC/RFJ-packaging discrepancy report (print errors) ;04 Oct 91
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
; ^tmp($j,"prcprpkg",nsn,itemda,error)=data where error=1-6
; ^tmp($j,"prcprpkg",nsn,itemda,7,vendor,suberror)=data
; ^tmp($j,"prcprpkg",nsn,itemda,8,transaction,suberror)=data
PRINT ; print errors
N %,%H,%I,D,ERROR,ITEMDA,NOW,NSN,PAGE,PRCPFLAG,PSDATA,SCREEN,SUBERROR,TRANDA,VENDA,VENDATA,X,Y
D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
S NSN="" F S NSN=$O(^TMP($J,"PRCPRPKG",NSN)) Q:NSN=""!($G(PRCPFLAG)) S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPRPKG",NSN,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG)) D
. I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
. W !!,NSN,?19,$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,25),?47,"[#",ITEMDA,"]",?55,$J($$UNIT^PRCPUX1(PRCP("I"),ITEMDA," per "),11)
. S ERROR=0 F S ERROR=$O(^TMP($J,"PRCPRPKG",NSN,ITEMDA,ERROR)) Q:'ERROR!($G(PRCPFLAG)) D
. . I $Y>(IOSL-7) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
. . I ERROR<7!(ERROR>14) D DISPLAY(ERROR,^TMP($J,"PRCPRPKG",NSN,ITEMDA,ERROR)) Q
. . I ERROR=7 D Q
. . . W !?3,"VENDOR (m=MAND)",?20,"[#V]",?27,"UNIT per PUR",?41,"UNIT per REC",?55,"CONV FACT",?71,"LAST COST"
. . . S VENDA=0 F S VENDA=$O(^TMP($J,"PRCPRPKG",NSN,ITEMDA,ERROR,VENDA)) Q:'VENDA!($D(PRCPFLAG)) D
. . . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
. . . . S VENDATA=$G(^PRC(441,ITEMDA,2,VENDA,0))
. . . . S PSDATA=$$GETVEN^PRCPUVEN(PRCP("I"),ITEMDA,VENDA_";PRC(440,",1)
. . . . W ! W:$P($G(^PRCP(445,PRCP("I"),1,ITEMDA,0)),"^",12)=VENDA ?1,"m" W ?3,$E($P($G(^PRC(440,VENDA,0)),"^"),1,15),?20,"[#",+VENDA,"]",?27,$J($$UNITVAL^PRCPUX1($P(VENDATA,"^",8),$P(VENDATA,"^",7)," per "),11)
. . . . W ?41,$J($$UNITVAL^PRCPUX1($P(PSDATA,"^",3),$P(PSDATA,"^",2)," per "),11),?55,$J($P(PSDATA,"^",4),9),?71,$J($P(VENDATA,"^",2),9)
. . . . S SUBERROR="" F S SUBERROR=$O(^TMP($J,"PRCPRPKG",NSN,ITEMDA,7,VENDA,SUBERROR)) Q:SUBERROR=""!($G(PRCPFLAG)) D
. . . . . D DISPLAY(7+SUBERROR,^TMP($J,"PRCPRPKG",NSN,ITEMDA,7,VENDA,SUBERROR))
. . . . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
. . I ERROR=8 D
. . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
. . . W !?3,"TRANSACTION",?28,"VENDOR",?50,"UNIT per REC",?65,"CF",?71,"QTY OUTST"
. . . S TRANDA=0 F S TRANDA=$O(^TMP($J,"PRCPRPKG",NSN,ITEMDA,8,TRANDA)) Q:'TRANDA!($G(PRCPFLAG)) S D=$G(^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA,0)) I D'="" D
. . . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
. . . . W !?3,$P($G(^PRCS(410,+TRANDA,0)),"^"),?28,$E($P($G(^PRC(440,+$P($G(^PRCS(410,+TRANDA,3)),"^",4),0)),"^"),1,20)
. . . . W ?50,$J($$UNITVAL^PRCPUX1($P(D,"^",4),$P(D,"^",3)," per "),11),?65,$J($P(D,"^",5),2),?70,$J($P(D,"^",2),10)
. . . . S SUBERROR="" F S SUBERROR=$O(^TMP($J,"PRCPRPKG",NSN,ITEMDA,8,TRANDA,SUBERROR)) Q:SUBERROR=""!($G(PRCPFLAG)) D
. . . . . D DISPLAY(8+SUBERROR,^TMP($J,"PRCPRPKG",NSN,ITEMDA,8,TRANDA,SUBERROR))
. . . . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
I '$G(PRCPFLAG) D END^PRCPUREP
Q
;
;
DISPLAY(V1,V2) ; process and display error message
N P1,P2,P3,X
S P1=$P(V2,"^"),P2=$P(V2,"^",2),P3=$P(V2,"^",3)
S X=$P($TEXT(ERRORS+V1),";",4,9)
I X["P1" S X=$P(X,"P1")_P1_$P(X,"P1",2)
I X["P2" S X=$P(X,"P2")_P2_$P(X,"P2",2)
I X["P3" S X=$P(X,"P3")_P3_$P(X,"P3",2)
S X(1)=X D DISPLAY^PRCPUX2(4,80,.X)
Q
;
;
H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
W $C(13),"PACKAGING DISCREPANCY REPORT FOR ",PRCP("IN"),?(80-$L(%)),%,!,"NSN",?19,"DESCRIPTION",?47,"[#MI]",?55,"UNIT per ISSUE",! S %="",$P(%,"-",81)="" W %
Q
;
;
ERRORS ;; error codes
;;1;Mandatory Source P1 not defined as a vendor in the item master file.
;;2;Unit of Purchase (P1) for mandatory source vendor P2 in item master file needs to be correctly entered.
;;3;Whse inventory point unit of issue (P1) should equal unit of purchase (P2) for mandatory source vendor P3 in the item master file.
;;4;Primary inventory point mandatory source P1 should equal mandatory source P2 from the item master file.
;;5;Primary inventory point mandatory source P1 needs to be added as a procurement source in the inventory point.
;;6;Primary inventory point unit of receipt (P1) for mandatory source P2 should equal the unit of purchase (P3) from the item master file.
;;7;Unit of purchase (P1) in item master file needs to be correctly entered.
;;8;Vendor needs to be added as a procurement source in the inventory point.
;;9;Unit of receipt (P1) should equal the unit of purchase (P2) from the item master file.
;;10;Vendor needs to be removed as a procurement source.
;;11;P1
;;12;Outstanding transaction unit of receipt (P1) should equal unit of purchase (P2).
;;13;
;;14;
;;15;NSN needs to be defined.
;;16;SKU (P1) should equal warehouse unit of issue (P2).
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRPK2 4953 printed Dec 13, 2024@02:15:24 Page 2
PRCPRPK2 ;WISC/RFJ-packaging discrepancy report (print errors) ;04 Oct 91
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
+6 ; ^tmp($j,"prcprpkg",nsn,itemda,error)=data where error=1-6
+7 ; ^tmp($j,"prcprpkg",nsn,itemda,7,vendor,suberror)=data
+8 ; ^tmp($j,"prcprpkg",nsn,itemda,8,transaction,suberror)=data
PRINT ; print errors
+1 NEW %,%H,%I,D,ERROR,ITEMDA,NOW,NSN,PAGE,PRCPFLAG,PSDATA,SCREEN,SUBERROR,TRANDA,VENDA,VENDATA,X,Y
+2 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET NOW=Y
SET PAGE=1
SET SCREEN=$$SCRPAUSE^PRCPUREP
USE IO
DO H
+3 SET NSN=""
FOR
SET NSN=$ORDER(^TMP($JOB,"PRCPRPKG",NSN))
if NSN=""!($GET(PRCPFLAG))
QUIT
SET ITEMDA=0
FOR
SET ITEMDA=$ORDER(^TMP($JOB,"PRCPRPKG",NSN,ITEMDA))
if 'ITEMDA!($GET(PRCPFLAG))
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-6)
if SCREEN
DO P^PRCPUREP
if $DATA(PRCPFLAG)
QUIT
DO H
+5 WRITE !!,NSN,?19,$EXTRACT($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,25),?47,"[#",ITEMDA,"]",?55,$JUSTIFY($$UNIT^PRCPUX1(PRCP("I"),ITEMDA," per "),11)
+6 SET ERROR=0
FOR
SET ERROR=$ORDER(^TMP($JOB,"PRCPRPKG",NSN,ITEMDA,ERROR))
if 'ERROR!($GET(PRCPFLAG))
QUIT
Begin DoDot:2
+7 IF $Y>(IOSL-7)
if SCREEN
DO P^PRCPUREP
if $DATA(PRCPFLAG)
QUIT
DO H
+8 IF ERROR<7!(ERROR>14)
DO DISPLAY(ERROR,^TMP($JOB,"PRCPRPKG",NSN,ITEMDA,ERROR))
QUIT
+9 IF ERROR=7
Begin DoDot:3
+10 WRITE !?3,"VENDOR (m=MAND)",?20,"[#V]",?27,"UNIT per PUR",?41,"UNIT per REC",?55,"CONV FACT",?71,"LAST COST"
+11 SET VENDA=0
FOR
SET VENDA=$ORDER(^TMP($JOB,"PRCPRPKG",NSN,ITEMDA,ERROR,VENDA))
if 'VENDA!($DATA(PRCPFLAG))
QUIT
Begin DoDot:4
+12 IF $Y>(IOSL-6)
if SCREEN
DO P^PRCPUREP
if $DATA(PRCPFLAG)
QUIT
DO H
+13 SET VENDATA=$GET(^PRC(441,ITEMDA,2,VENDA,0))
+14 SET PSDATA=$$GETVEN^PRCPUVEN(PRCP("I"),ITEMDA,VENDA_";PRC(440,",1)
+15 WRITE !
if $PIECE($GET(^PRCP(445,PRCP("I"),1,ITEMDA,0)),"^",12)=VENDA
WRITE ?1,"m"
WRITE ?3,$EXTRACT($PIECE($GET(^PRC(440,VENDA,0)),"^"),1,15),?20,"[#",+VENDA,"]",?27,$JUSTIFY($$UNITVAL^PRCPUX1($PIECE(VENDATA,"^",8),$PIECE(VENDATA,"^",7)," per "),11)
+16 WRITE ?41,$JUSTIFY($$UNITVAL^PRCPUX1($PIECE(PSDATA,"^",3),$PIECE(PSDATA,"^",2)," per "),11),?55,$JUSTIFY($PIECE(PSDATA,"^",4),9),?71,$JUSTIFY($PIECE(VENDATA,"^",2),9)
+17 SET SUBERROR=""
FOR
SET SUBERROR=$ORDER(^TMP($JOB,"PRCPRPKG",NSN,ITEMDA,7,VENDA,SUBERROR))
if SUBERROR=""!($GET(PRCPFLAG))
QUIT
Begin DoDot:5
+18 DO DISPLAY(7+SUBERROR,^TMP($JOB,"PRCPRPKG",NSN,ITEMDA,7,VENDA,SUBERROR))
+19 IF $Y>(IOSL-6)
if SCREEN
DO P^PRCPUREP
if $DATA(PRCPFLAG)
QUIT
DO H
End DoDot:5
End DoDot:4
End DoDot:3
QUIT
+20 IF ERROR=8
Begin DoDot:3
+21 IF $Y>(IOSL-6)
if SCREEN
DO P^PRCPUREP
if $DATA(PRCPFLAG)
QUIT
DO H
+22 WRITE !?3,"TRANSACTION",?28,"VENDOR",?50,"UNIT per REC",?65,"CF",?71,"QTY OUTST"
+23 SET TRANDA=0
FOR
SET TRANDA=$ORDER(^TMP($JOB,"PRCPRPKG",NSN,ITEMDA,8,TRANDA))
if 'TRANDA!($GET(PRCPFLAG))
QUIT
SET D=$GET(^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA,0))
IF D'=""
Begin DoDot:4
+24 IF $Y>(IOSL-6)
if SCREEN
DO P^PRCPUREP
if $DATA(PRCPFLAG)
QUIT
DO H
+25 WRITE !?3,$PIECE($GET(^PRCS(410,+TRANDA,0)),"^"),?28,$EXTRACT($PIECE($GET(^PRC(440,+$PIECE($GET(^PRCS(410,+TRANDA,3)),"^",4),0)),"^"),1,20)
+26 WRITE ?50,$JUSTIFY($$UNITVAL^PRCPUX1($PIECE(D,"^",4),$PIECE(D,"^",3)," per "),11),?65,$JUSTIFY($PIECE(D,"^",5),2),?70,$JUSTIFY($PIECE(D,"^",2),10)
+27 SET SUBERROR=""
FOR
SET SUBERROR=$ORDER(^TMP($JOB,"PRCPRPKG",NSN,ITEMDA,8,TRANDA,SUBERROR))
if SUBERROR=""!($GET(PRCPFLAG))
QUIT
Begin DoDot:5
+28 DO DISPLAY(8+SUBERROR,^TMP($JOB,"PRCPRPKG",NSN,ITEMDA,8,TRANDA,SUBERROR))
+29 IF $Y>(IOSL-6)
if SCREEN
DO P^PRCPUREP
if $DATA(PRCPFLAG)
QUIT
DO H
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+30 IF '$GET(PRCPFLAG)
DO END^PRCPUREP
+31 QUIT
+32 ;
+33 ;
DISPLAY(V1,V2) ; process and display error message
+1 NEW P1,P2,P3,X
+2 SET P1=$PIECE(V2,"^")
SET P2=$PIECE(V2,"^",2)
SET P3=$PIECE(V2,"^",3)
+3 SET X=$PIECE($TEXT(ERRORS+V1),";",4,9)
+4 IF X["P1"
SET X=$PIECE(X,"P1")_P1_$PIECE(X,"P1",2)
+5 IF X["P2"
SET X=$PIECE(X,"P2")_P2_$PIECE(X,"P2",2)
+6 IF X["P3"
SET X=$PIECE(X,"P3")_P3_$PIECE(X,"P3",2)
+7 SET X(1)=X
DO DISPLAY^PRCPUX2(4,80,.X)
+8 QUIT
+9 ;
+10 ;
H SET %=NOW_" PAGE "_PAGE
SET PAGE=PAGE+1
IF PAGE'=2!(SCREEN)
WRITE @IOF
+1 WRITE $CHAR(13),"PACKAGING DISCREPANCY REPORT FOR ",PRCP("IN"),?(80-$LENGTH(%)),%,!,"NSN",?19,"DESCRIPTION",?47,"[#MI]",?55,"UNIT per ISSUE",!
SET %=""
SET $PIECE(%,"-",81)=""
WRITE %
+2 QUIT
+3 ;
+4 ;
ERRORS ;; error codes
+1 ;;1;Mandatory Source P1 not defined as a vendor in the item master file.
+2 ;;2;Unit of Purchase (P1) for mandatory source vendor P2 in item master file needs to be correctly entered.
+3 ;;3;Whse inventory point unit of issue (P1) should equal unit of purchase (P2) for mandatory source vendor P3 in the item master file.
+4 ;;4;Primary inventory point mandatory source P1 should equal mandatory source P2 from the item master file.
+5 ;;5;Primary inventory point mandatory source P1 needs to be added as a procurement source in the inventory point.
+6 ;;6;Primary inventory point unit of receipt (P1) for mandatory source P2 should equal the unit of purchase (P3) from the item master file.
+7 ;;7;Unit of purchase (P1) in item master file needs to be correctly entered.
+8 ;;8;Vendor needs to be added as a procurement source in the inventory point.
+9 ;;9;Unit of receipt (P1) should equal the unit of purchase (P2) from the item master file.
+10 ;;10;Vendor needs to be removed as a procurement source.
+11 ;;11;P1
+12 ;;12;Outstanding transaction unit of receipt (P1) should equal unit of purchase (P2).
+13 ;;13;
+14 ;;14;
+15 ;;15;NSN needs to be defined.
+16 ;;16;SKU (P1) should equal warehouse unit of issue (P2).
