PRCPAGRE.m

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 ---PRCPAGRE   1188     printed  Apr 09, 2024@21:14:42                                                                                                                                                                                                    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