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 ---[H[J[2J[HPRCACV10 3072 printed Apr 09, 2024@20:46:07 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.
