source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCACV10.m@ 1710

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

initial load of WorldVistAEHR

File size: 2.9 KB
RevLine 
[613]1PRCACV10 ;WASH-ISC@ALTOONA,PA/CTB/CLH-COMPILE ALL PRINT AND INPUT TEMPLATES AND CROSS REFERENCES FOR AR ;7/26/94 11:20 AM
2V ;;4.5;Accounts Receivable;;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4ALL ;process input and print templates
5 N SIZE
6 S SIZE=$$SIZE Q:'SIZE
7 D DIEZ,DIPZ,DIKZ
8 QUIT
9DIEZ N TAG,ZZZI,X,RTNNAME,TEMPLATE,FILE
10 I $G(SIZE)<3000 N SIZE S SIZE=$$SIZE Q:'SIZE
11 S TAG="DATAI"
12 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)
13 QUIT
14DIPZ N TAG,ZZZI,X,RTNNAME,TEMPLATE,FILE
15 I $G(SIZE)<3000 N SIZE S SIZE=$$SIZE Q:'SIZE
16 S TAG="DATAP"
17 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)
18 QUIT
19DIKZ N TAG,ZZZI,STRING,X,Y,DMAX
20 I $G(SIZE)<3000 N SIZE S SIZE=$$SIZE Q:'SIZE
21 S TAG="DATAC"
22 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
23 QUIT
24SIZE() ;
25 NEW DIR,X,Y
26 S DIR(0)="N^3000:5000:0",DIR("A")="Select Routine Size",DIR("B")=4000 D ^DIR
27 I +($G(DTOUT)_$G(DUOUT)_$G(DIRUT)_$G(DIROUT)) K DTOUT,DUOUT,DIRUT,DIROUT K SIZE QUIT 0
28 Q Y
29INPUT(RTN,NAME,FILE,DMAX) S DIC="^DIE(",DIC(0)="MO",X=NAME D ^DIC D
30 . I Y<0 D Q:Y<0
31 . . S Y=$O(^DIE("B",NAME,N)) I Y="" S Y=-1 QUIT
32 . . S Y=0 F S Y=$O(^DIE("B",NAME,Y)) Q:$P($G(^DIE(+Y,0)),"^",4)=FILE
33 . . S:Y="" Y=-1
34 . . QUIT
35 . S Y=+Y,X=RTN W !!!!,"Template ",NAME," Compiling to Routine ",X D EN^DIEZ
36 . QUIT
37 QUIT
38PRINT(RTN,NAME,FILE,DMAX) S DIC="^DIPT(",DIC(0)="MO",X=NAME D ^DIC D
39 . I Y<0 D
40 . . S Y=$O(^DIPT("B",NAME,N)) I Y="" S Y=-1 QUIT
41 . . S Y=0 F S Y=$O(^DIPT("B",NAME,Y)) Q:$P($G(^DIPT(+Y,0)),"^",4)=FILE
42 . . S:Y="" Y=-1
43 . . QUIT
44 . QUIT:Y<0
45 . S Y=+Y,X=RTN W !!!!,"Template ",NAME," Compiling to routine ",X D EN^DIPZ
46 . QUIT
47 QUIT
48DATAI ;;INPUT TEMPLATE NAME;COMPILED ROUTINE NAME;FILE NUMBER
49 ;;PRCA BATCH PAYMENT;PRCATB;433
50 ;;PRCASV REL;PRCATSE;430
51 ;;PRCA OLD SET;PRCATA;430
52 ;;PRCA SET;PRCATE;430
53 ;;; THIS LINE IS ESSENTIAL.
54DATAP ;;PRINT TEMPLATE NAME;COMPILED ROUTINE NAME;FILE NUMBER
55 ;;PRCA 3RD PROFILE;PRCATP5;430
56 ;;PRCA DISP ADJ;PRCATO4;433
57 ;;PRCA DISP AUDIT;PRCATO2;430
58 ;;PRCA DISP CARE;PRCATO5;433
59 ;;PRCA FMS STATUS;PRCATF;347
60 ;;PRCA FMS TRANS STAT;PRCATF2;347
61 ;;PRCA MEANS PROFILE;PRCATP2;430
62 ;;PRCA OTHER PROFILE;PRCATP4;430
63 ;;PRCA PROFILE;PRCATP1;430
64 ;;PRCA TRANS PROFILE;PRCATR3;433
65 ;;PRCA VENDOR PROFILE;PRCATP3;430
66 ;;PRCAA AMEND AUDIT;PRCATR2;430
67 ;;PRCAC TR LIST;PRCATW1;433
68 ;;PRCAP CARE WV;PRCATW3;433
69 ;;PRCAP COST;PRCATO3;433
70 ;;PRCAP DEBTOR LOCATE;PRCATO9;430
71 ;;PRCAP REPAYMENT;PRCATR1;430
72 ;;PRCAP RETURN BILL;PRCATP6;430
73 ;;PRCAP WAIVED;PRCATW2;433
74 ;;PRCARFD;PRCATRF;430
75 ;;PRCAT DISP CP;PRCATO8;430
76 ;;PRCAT NEW AR;PRCATP7;430
77 ;;PRCAT NEW TRANS;PRCATP9;433
78 ;;; THIS LINE IS ESSENTIAL.
79DATAC ;;CROSS REFERENCES FILE NUMBER;ROUTINE NAME
80 ;;; THIS LINE IS ESSENTIAL.
Note: See TracBrowser for help on using the repository browser.