81 lines
2.9 KiB
Mathematica
81 lines
2.9 KiB
Mathematica
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.
|