source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPAGRE.m@ 810

Last change on this file since 810 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.1 KB
RevLine 
[613]1PRCPAGRE ;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 ;
7ERROR ; 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 ;
22H 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
Note: See TracBrowser for help on using the repository browser.