PRCPAGRE ;WISC/RFJ,DXH - autogen print error report ;10.5.99
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
ERROR ; print error report
; from ^tmp($j,"prcpag","er",xxx,itemda) where xxx equals
; whse:nsn; prim or seco:description
N %,%H,%I,DESCNSN,ERROR,ITEMDA,NOW,PAGE,SCREEN,X,Y
D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
S DESCNSN="" F S DESCNSN=$O(^TMP($J,"PRCPAG","ER",DESCNSN)) Q:DESCNSN="" S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPAG","ER",DESCNSN,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG)) S ERROR=^(ITEMDA) D
. W !!,ITEMDA,?7,$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,55)
. I PRCP("DPTYPE")="W" W ?63,$$NSN^PRCPUX1(ITEMDA)
. F W !?7,"-> ",$E(ERROR,1,69) S ERROR=$E(ERROR,70,200) S:$E(ERROR)=" " ERROR=$E(ERROR,2,200) I ERROR="" Q
. I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
I $G(PRCPFLAG) Q
D END^PRCPUREP
Q
;
;
H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
W $C(13),"AUTO-GEN ERRORS FOR ",$E(PRCP("IN"),1,20),?(82-$L(%)),%,!,"MI#",?7,"DESCRIPTION"
I PRCP("DPTYPE")="W" W ?63,"NSN"
S %="",$P(%,"-",81)="" W !,%
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPAGRE 1188 printed Dec 13, 2024@02:12:36 Page 2
PRCPAGRE ;WISC/RFJ,DXH - autogen print error report ;10.5.99
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
ERROR ; print error report
+1 ; from ^tmp($j,"prcpag","er",xxx,itemda) where xxx equals
+2 ; whse:nsn; prim or seco:description
+3 NEW %,%H,%I,DESCNSN,ERROR,ITEMDA,NOW,PAGE,SCREEN,X,Y
+4 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET NOW=Y
SET PAGE=1
SET SCREEN=$$SCRPAUSE^PRCPUREP
USE IO
DO H
+5 SET DESCNSN=""
FOR
SET DESCNSN=$ORDER(^TMP($JOB,"PRCPAG","ER",DESCNSN))
if DESCNSN=""
QUIT
SET ITEMDA=0
FOR
SET ITEMDA=$ORDER(^TMP($JOB,"PRCPAG","ER",DESCNSN,ITEMDA))
if 'ITEMDA!($GET(PRCPFLAG))
QUIT
SET ERROR=^(ITEMDA)
Begin DoDot:1
+6 WRITE !!,ITEMDA,?7,$EXTRACT($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,55)
+7 IF PRCP("DPTYPE")="W"
WRITE ?63,$$NSN^PRCPUX1(ITEMDA)
+8 FOR
WRITE !?7,"-> ",$EXTRACT(ERROR,1,69)
SET ERROR=$EXTRACT(ERROR,70,200)
if $EXTRACT(ERROR)=" "
SET ERROR=$EXTRACT(ERROR,2,200)
IF ERROR=""
QUIT
+9 IF $Y>(IOSL-6)
if SCREEN
DO P^PRCPUREP
if $GET(PRCPFLAG)
QUIT
DO H
End DoDot:1
+10 IF $GET(PRCPFLAG)
QUIT
+11 DO END^PRCPUREP
+12 QUIT
+13 ;
+14 ;
H SET %=NOW_" PAGE "_PAGE
SET PAGE=PAGE+1
IF PAGE'=2!(SCREEN)
WRITE @IOF
+1 WRITE $CHAR(13),"AUTO-GEN ERRORS FOR ",$EXTRACT(PRCP("IN"),1,20),?(82-$LENGTH(%)),%,!,"MI#",?7,"DESCRIPTION"
+2 IF PRCP("DPTYPE")="W"
WRITE ?63,"NSN"
+3 SET %=""
SET $PIECE(%,"-",81)=""
WRITE !,%
+4 QUIT
