1 | PRCPAGRE ;WISC/RFJ,DXH - autogen print error report ;10.5.99
|
---|
2 | ;;5.1;IFCAP;;Oct 20, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | Q
|
---|
5 | ;
|
---|
6 | ;
|
---|
7 | ERROR ; print error report
|
---|
8 | ; from ^tmp($j,"prcpag","er",xxx,itemda) where xxx equals
|
---|
9 | ; whse:nsn; prim or seco:description
|
---|
10 | N %,%H,%I,DESCNSN,ERROR,ITEMDA,NOW,PAGE,SCREEN,X,Y
|
---|
11 | D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
|
---|
12 | 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
|
---|
13 | . W !!,ITEMDA,?7,$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,55)
|
---|
14 | . I PRCP("DPTYPE")="W" W ?63,$$NSN^PRCPUX1(ITEMDA)
|
---|
15 | . F W !?7,"-> ",$E(ERROR,1,69) S ERROR=$E(ERROR,70,200) S:$E(ERROR)=" " ERROR=$E(ERROR,2,200) I ERROR="" Q
|
---|
16 | . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
|
---|
17 | I $G(PRCPFLAG) Q
|
---|
18 | D END^PRCPUREP
|
---|
19 | Q
|
---|
20 | ;
|
---|
21 | ;
|
---|
22 | H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
|
---|
23 | W $C(13),"AUTO-GEN ERRORS FOR ",$E(PRCP("IN"),1,20),?(82-$L(%)),%,!,"MI#",?7,"DESCRIPTION"
|
---|
24 | I PRCP("DPTYPE")="W" W ?63,"NSN"
|
---|
25 | S %="",$P(%,"-",81)="" W !,%
|
---|
26 | Q
|
---|