PRCACV10.m

PRCACV10 ;WASH-ISC@ALTOONA,PA/CTB/CLH-COMPILE ALL PRINT AND INPUT TEMPLATES AND CROSS REFERENCES FOR AR ;7/26/94  11:20 AM

V ;;4.5;Accounts Receivable;;Mar 20, 1995

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

ALL ;process input and print templates

 N SIZE

 S SIZE=$$SIZE Q:'SIZE

 D DIEZ,DIPZ,DIKZ

 QUIT

DIEZ N TAG,ZZZI,X,RTNNAME,TEMPLATE,FILE

 I $G(SIZE)<3000 N SIZE S SIZE=$$SIZE Q:'SIZE

 S TAG="DATAI"

 F ZZZI=1:1 S X=$T(@(TAG)+ZZZI) S RTNNAME=$P(X,";",4),TEMPLATE=$P(X,";",3),FILE=$P(X,";",5) Q:RTNNAME=""!(TEMPLATE="")  D INPUT(RTNNAME,TEMPLATE,FILE,SIZE)

 QUIT

DIPZ N TAG,ZZZI,X,RTNNAME,TEMPLATE,FILE

 I $G(SIZE)<3000 N SIZE S SIZE=$$SIZE Q:'SIZE

 S TAG="DATAP"

 F ZZZI=1:1 S X=$T(@(TAG)+ZZZI) S RTNNAME=$P(X,";",4),TEMPLATE=$P(X,";",3),FILE=$P(X,";",5) Q:RTNNAME=""!(TEMPLATE="")  D PRINT(RTNNAME,TEMPLATE,FILE,SIZE)

 QUIT

DIKZ N TAG,ZZZI,STRING,X,Y,DMAX

 I $G(SIZE)<3000 N SIZE S SIZE=$$SIZE Q:'SIZE

 S TAG="DATAC"

 F ZZZI=1:1 S STRING=$T(@(TAG)+ZZZI) S X=$P(STRING,";",4),Y=$P(STRING,";",3),DMAX=SIZE Q:X=""!(Y="")  D EN^DIKZ

 QUIT

SIZE() ;

 NEW DIR,X,Y

 S DIR(0)="N^3000:5000:0",DIR("A")="Select Routine Size",DIR("B")=4000 D ^DIR

 I +($G(DTOUT)_$G(DUOUT)_$G(DIRUT)_$G(DIROUT)) K DTOUT,DUOUT,DIRUT,DIROUT K SIZE QUIT 0

 Q Y

INPUT(RTN,NAME,FILE,DMAX) S DIC="^DIE(",DIC(0)="MO",X=NAME D ^DIC D

 . I Y<0 D  Q:Y<0

 . . S Y=$O(^DIE("B",NAME,N)) I Y="" S Y=-1 QUIT

 . . S Y=0 F  S Y=$O(^DIE("B",NAME,Y)) Q:$P($G(^DIE(+Y,0)),"^",4)=FILE

 . . S:Y="" Y=-1

 . . QUIT

 . S Y=+Y,X=RTN W !!!!,"Template ",NAME," Compiling to Routine ",X D EN^DIEZ

 . QUIT

 QUIT

PRINT(RTN,NAME,FILE,DMAX) S DIC="^DIPT(",DIC(0)="MO",X=NAME D ^DIC D

 . I Y<0 D

 . . S Y=$O(^DIPT("B",NAME,N)) I Y="" S Y=-1 QUIT

 . . S Y=0 F  S Y=$O(^DIPT("B",NAME,Y)) Q:$P($G(^DIPT(+Y,0)),"^",4)=FILE

 . . S:Y="" Y=-1

 . . QUIT

 . QUIT:Y<0

 . S Y=+Y,X=RTN W !!!!,"Template ",NAME," Compiling to routine ",X D EN^DIPZ

 . QUIT

 QUIT

DATAI ;;INPUT TEMPLATE NAME;COMPILED ROUTINE NAME;FILE NUMBER

 ;;PRCA BATCH PAYMENT;PRCATB;433

 ;;PRCASV REL;PRCATSE;430

 ;;PRCA OLD SET;PRCATA;430

 ;;PRCA SET;PRCATE;430

 ;;; THIS LINE IS ESSENTIAL.

DATAP ;;PRINT TEMPLATE NAME;COMPILED ROUTINE NAME;FILE NUMBER

 ;;PRCA 3RD PROFILE;PRCATP5;430

 ;;PRCA DISP ADJ;PRCATO4;433

 ;;PRCA DISP AUDIT;PRCATO2;430

 ;;PRCA DISP CARE;PRCATO5;433

 ;;PRCA FMS STATUS;PRCATF;347

 ;;PRCA FMS TRANS STAT;PRCATF2;347

 ;;PRCA MEANS PROFILE;PRCATP2;430

 ;;PRCA OTHER PROFILE;PRCATP4;430

 ;;PRCA PROFILE;PRCATP1;430

 ;;PRCA TRANS PROFILE;PRCATR3;433

 ;;PRCA VENDOR PROFILE;PRCATP3;430

 ;;PRCAA AMEND AUDIT;PRCATR2;430

 ;;PRCAC TR LIST;PRCATW1;433

 ;;PRCAP CARE WV;PRCATW3;433

 ;;PRCAP COST;PRCATO3;433

 ;;PRCAP DEBTOR LOCATE;PRCATO9;430

 ;;PRCAP REPAYMENT;PRCATR1;430

 ;;PRCAP RETURN BILL;PRCATP6;430

 ;;PRCAP WAIVED;PRCATW2;433

 ;;PRCARFD;PRCATRF;430

 ;;PRCAT DISP CP;PRCATO8;430

 ;;PRCAT NEW AR;PRCATP7;430

 ;;PRCAT NEW TRANS;PRCATP9;433

 ;;; THIS LINE IS ESSENTIAL.

DATAC ;;CROSS REFERENCES FILE NUMBER;ROUTINE NAME

 ;;; THIS LINE IS ESSENTIAL.

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCACV10   3072     printed  Mar 13, 2025@20:43:56                                                                                                                                                                                                    Page 2

PRCACV10  ;WASH-ISC@ALTOONA,PA/CTB/CLH-COMPILE ALL PRINT AND INPUT TEMPLATES AND CROSS REFERENCES FOR AR ;7/26/94  11:20 AM

V         ;;4.5;Accounts Receivable;;Mar 20, 1995

 +1       ;;Per VHA Directive 10-93-142, this routine should not be modified.

ALL       ;process input and print templates

 +1        NEW SIZE

 +2        SET SIZE=$$SIZE

           if 'SIZE

               QUIT 

 +3        DO DIEZ

           DO DIPZ

           DO DIKZ

 +4        QUIT 

DIEZ       NEW TAG,ZZZI,X,RTNNAME,TEMPLATE,FILE

 +1        IF $GET(SIZE)<3000

               NEW SIZE

               SET SIZE=$$SIZE

               if 'SIZE

                   QUIT 

 +2        SET TAG="DATAI"

 +3        FOR ZZZI=1:1

               SET X=$TEXT(@(TAG)+ZZZI)

               SET RTNNAME=$PIECE(X,";",4)

               SET TEMPLATE=$PIECE(X,";",3)

               SET FILE=$PIECE(X,";",5)

               if RTNNAME=""!(TEMPLATE="")

                   QUIT 

               DO INPUT(RTNNAME,TEMPLATE,FILE,SIZE)

 +4        QUIT 

DIPZ       NEW TAG,ZZZI,X,RTNNAME,TEMPLATE,FILE

 +1        IF $GET(SIZE)<3000

               NEW SIZE

               SET SIZE=$$SIZE

               if 'SIZE

                   QUIT 

 +2        SET TAG="DATAP"

 +3        FOR ZZZI=1:1

               SET X=$TEXT(@(TAG)+ZZZI)

               SET RTNNAME=$PIECE(X,";",4)

               SET TEMPLATE=$PIECE(X,";",3)

               SET FILE=$PIECE(X,";",5)

               if RTNNAME=""!(TEMPLATE="")

                   QUIT 

               DO PRINT(RTNNAME,TEMPLATE,FILE,SIZE)

 +4        QUIT 

DIKZ       NEW TAG,ZZZI,STRING,X,Y,DMAX

 +1        IF $GET(SIZE)<3000

               NEW SIZE

               SET SIZE=$$SIZE

               if 'SIZE

                   QUIT 

 +2        SET TAG="DATAC"

 +3        FOR ZZZI=1:1

               SET STRING=$TEXT(@(TAG)+ZZZI)

               SET X=$PIECE(STRING,";",4)

               SET Y=$PIECE(STRING,";",3)

               SET DMAX=SIZE

               if X=""!(Y="")

                   QUIT 

               DO EN^DIKZ

 +4        QUIT 

SIZE()    ;

 +1        NEW DIR,X,Y

 +2        SET DIR(0)="N^3000:5000:0"

           SET DIR("A")="Select Routine Size"

           SET DIR("B")=4000

           DO ^DIR

 +3        IF +($GET(DTOUT)_$GET(DUOUT)_$GET(DIRUT)_$GET(DIROUT))

               KILL DTOUT,DUOUT,DIRUT,DIROUT

               KILL SIZE

               QUIT 0

 +4        QUIT Y

INPUT(RTN,NAME,FILE,DMAX)  SET DIC="^DIE("

           SET DIC(0)="MO"

           SET X=NAME

           DO ^DIC

           Begin DoDot:1

 +1            IF Y<0

                   Begin DoDot:2

 +2                    SET Y=$ORDER(^DIE("B",NAME,N))

                       IF Y=""

                           SET Y=-1

                           QUIT 

 +3                    SET Y=0

                       FOR 

                           SET Y=$ORDER(^DIE("B",NAME,Y))

                           if $PIECE($GET(^DIE(+Y,0)),"^",4)=FILE

                               QUIT 

 +4                    if Y=""

                           SET Y=-1

 +5                    QUIT 

                   End DoDot:2

                   if Y<0

                       QUIT 

 +6            SET Y=+Y

               SET X=RTN

               WRITE !!!!,"Template ",NAME," Compiling to Routine ",X

               DO EN^DIEZ

 +7            QUIT 

           End DoDot:1

 +8        QUIT 

PRINT(RTN,NAME,FILE,DMAX)  SET DIC="^DIPT("

           SET DIC(0)="MO"

           SET X=NAME

           DO ^DIC

           Begin DoDot:1

 +1            IF Y<0

                   Begin DoDot:2

 +2                    SET Y=$ORDER(^DIPT("B",NAME,N))

                       IF Y=""

                           SET Y=-1

                           QUIT 

 +3                    SET Y=0

                       FOR 

                           SET Y=$ORDER(^DIPT("B",NAME,Y))

                           if $PIECE($GET(^DIPT(+Y,0)),"^",4)=FILE

                               QUIT 

 +4                    if Y=""

                           SET Y=-1

 +5                    QUIT 

                   End DoDot:2

 +6            if Y<0

                   QUIT 

 +7            SET Y=+Y

               SET X=RTN

               WRITE !!!!,"Template ",NAME," Compiling to routine ",X

               DO EN^DIPZ

 +8            QUIT 

           End DoDot:1

 +9        QUIT 

DATAI     ;;INPUT TEMPLATE NAME;COMPILED ROUTINE NAME;FILE NUMBER

 +1       ;;PRCA BATCH PAYMENT;PRCATB;433

 +2       ;;PRCASV REL;PRCATSE;430

 +3       ;;PRCA OLD SET;PRCATA;430

 +4       ;;PRCA SET;PRCATE;430

 +5       ;;; THIS LINE IS ESSENTIAL.

DATAP     ;;PRINT TEMPLATE NAME;COMPILED ROUTINE NAME;FILE NUMBER

 +1       ;;PRCA 3RD PROFILE;PRCATP5;430

 +2       ;;PRCA DISP ADJ;PRCATO4;433

 +3       ;;PRCA DISP AUDIT;PRCATO2;430

 +4       ;;PRCA DISP CARE;PRCATO5;433

 +5       ;;PRCA FMS STATUS;PRCATF;347

 +6       ;;PRCA FMS TRANS STAT;PRCATF2;347

 +7       ;;PRCA MEANS PROFILE;PRCATP2;430

 +8       ;;PRCA OTHER PROFILE;PRCATP4;430

 +9       ;;PRCA PROFILE;PRCATP1;430

 +10      ;;PRCA TRANS PROFILE;PRCATR3;433

 +11      ;;PRCA VENDOR PROFILE;PRCATP3;430

 +12      ;;PRCAA AMEND AUDIT;PRCATR2;430

 +13      ;;PRCAC TR LIST;PRCATW1;433

 +14      ;;PRCAP CARE WV;PRCATW3;433

 +15      ;;PRCAP COST;PRCATO3;433

 +16      ;;PRCAP DEBTOR LOCATE;PRCATO9;430

 +17      ;;PRCAP REPAYMENT;PRCATR1;430

 +18      ;;PRCAP RETURN BILL;PRCATP6;430

 +19      ;;PRCAP WAIVED;PRCATW2;433

 +20      ;;PRCARFD;PRCATRF;430

 +21      ;;PRCAT DISP CP;PRCATO8;430

 +22      ;;PRCAT NEW AR;PRCATP7;430

 +23      ;;PRCAT NEW TRANS;PRCATP9;433

 +24      ;;; THIS LINE IS ESSENTIAL.

DATAC     ;;CROSS REFERENCES FILE NUMBER;ROUTINE NAME

 +1       ;;; THIS LINE IS ESSENTIAL.