source: FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCACV10.m@ 628

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.