IBEFUTL1 ;ALB/MJK/AAS - Re-Compile Templates/x-refs ; 1/31/92
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; ******* DO NOT MAP THIS ROUTINE *******
Q
;
EN ; Entry point to re-compile templates
; input: IBKIND = OUTPUT or INPUT
;
K IBLINE S U="^",$P(IBLINE,"=",81)="",IBMAX=^DD("ROU")
G ENQ:'$D(IBKIND),ENQ:"^OUTPUT^INPUT^"'[(U_IBKIND_U)
I IBKIND="OUTPUT" S IBFILE="^DIPT",IBROU="EN^DIPZ"
I IBKIND="INPUT" S IBFILE="^DIE",IBROU="EN^DIEZ"
W !,IBLINE,!?20,"Recompilation of '",IBKIND,"' Templates",!,IBLINE
;
S IBX="IAzzz" F IBI=1:1 S IBX=$O(@IBFILE@("B",IBX)) Q:IBX=""!($E(IBX,1,2)'="IB") S Y=+$O(^(IBX,0)) I $D(@IBFILE@(Y,"ROUOLD")),^("ROUOLD")]"",$D(^(0)) S (IBEMP,Y)=Y,X=$P(^("ROUOLD"),"^"),IB0=^(0) D COMP
;
ENQ K IBROU,IB0,IBX,IBI,IBMAX,IBEMP,IBFILE,IBI,IBLINE Q
;
COMP ; re-compile
;
;
S DMAX=IBMAX D @IBROU W !!,IBLINE
COMPQ Q
;
ALL ; compile templates and x-refs
S:'$D(DTIME) DTIME=300 S U="^"
S DIR(0)="Y",DIR("A")="Re-compile all 'IB' templates and cross references"
S DIR("?",1)="Yes to re-compile",DIR("?",2)="No to stop recompilation process",DIR("?")=" "
D ^DIR K DIR G ALLQ:'Y
D DIEZ W !!
D DIPZ W !!
D DIKZ
W !!,"...Done.",!!,"NOTE: Recompilation should be performed on ALL systems."
ALLQ K A,C,L,O,X1,DQ,DIE,DMAX,DIEZ,DIEZDUP,DK,DR Q
;
DIEZ ; -- re-compile all IB 'edit' templates
S IBKIND="INPUT" D EN K IBKIND Q
;
DIPZ ; -- re-compile all IB 'print' templates
S IBKIND="OUTPUT" D EN K IBKIND Q
;
DIKZ ; -- compile x-refs
W !!,">>> Compiling cross references for BILL/CLAIMS, INTEGRATED BILLING, and ENCOUNTER FORM files:"
F IBN=399,350,357,357.1,357.2,357.3,357.4,357.5 S N=IBN W ! I $D(^DD(+N,0,"DIK"))#2 S X=^("DIK"),Y=+N,DMAX=^DD("ROU") W !,"** File "_IBN_" **",! D EN^DIKZ
K IBN,N,DMAX
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBEFUTL1 1872 printed Nov 22, 2024@17:32:07 Page 2
IBEFUTL1 ;ALB/MJK/AAS - Re-Compile Templates/x-refs ; 1/31/92
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; ******* DO NOT MAP THIS ROUTINE *******
+5 QUIT
+6 ;
EN ; Entry point to re-compile templates
+1 ; input: IBKIND = OUTPUT or INPUT
+2 ;
+3 KILL IBLINE
SET U="^"
SET $PIECE(IBLINE,"=",81)=""
SET IBMAX=^DD("ROU")
+4 if '$DATA(IBKIND)
GOTO ENQ
if "^OUTPUT^INPUT^"'[(U_IBKIND_U)
GOTO ENQ
+5 IF IBKIND="OUTPUT"
SET IBFILE="^DIPT"
SET IBROU="EN^DIPZ"
+6 IF IBKIND="INPUT"
SET IBFILE="^DIE"
SET IBROU="EN^DIEZ"
+7 WRITE !,IBLINE,!?20,"Recompilation of '",IBKIND,"' Templates",!,IBLINE
+8 ;
+9 SET IBX="IAzzz"
FOR IBI=1:1
SET IBX=$ORDER(@IBFILE@("B",IBX))
if IBX=""!($EXTRACT(IBX,1,2)'="IB")
QUIT
SET Y=+$ORDER(^(IBX,0))
IF $DATA(@IBFILE@(Y,"ROUOLD"))
IF ^("ROUOLD")]""
IF $DATA(^(0))
SET (IBEMP,Y)=Y
SET X=$PIECE(^("ROUOLD"),"^")
SET IB0=^(0)
DO COMP
+10 ;
ENQ KILL IBROU,IB0,IBX,IBI,IBMAX,IBEMP,IBFILE,IBI,IBLINE
QUIT
+1 ;
COMP ; re-compile
+1 ;
+2 ;
+3 SET DMAX=IBMAX
DO @IBROU
WRITE !!,IBLINE
COMPQ QUIT
+1 ;
ALL ; compile templates and x-refs
+1 if '$DATA(DTIME)
SET DTIME=300
SET U="^"
+2 SET DIR(0)="Y"
SET DIR("A")="Re-compile all 'IB' templates and cross references"
+3 SET DIR("?",1)="Yes to re-compile"
SET DIR("?",2)="No to stop recompilation process"
SET DIR("?")=" "
+4 DO ^DIR
KILL DIR
if 'Y
GOTO ALLQ
+5 DO DIEZ
WRITE !!
+6 DO DIPZ
WRITE !!
+7 DO DIKZ
+8 WRITE !!,"...Done.",!!,"NOTE: Recompilation should be performed on ALL systems."
ALLQ KILL A,C,L,O,X1,DQ,DIE,DMAX,DIEZ,DIEZDUP,DK,DR
QUIT
+1 ;
DIEZ ; -- re-compile all IB 'edit' templates
+1 SET IBKIND="INPUT"
DO EN
KILL IBKIND
QUIT
+2 ;
DIPZ ; -- re-compile all IB 'print' templates
+1 SET IBKIND="OUTPUT"
DO EN
KILL IBKIND
QUIT
+2 ;
DIKZ ; -- compile x-refs
+1 WRITE !!,">>> Compiling cross references for BILL/CLAIMS, INTEGRATED BILLING, and ENCOUNTER FORM files:"
+2 FOR IBN=399,350,357,357.1,357.2,357.3,357.4,357.5
SET N=IBN
WRITE !
IF $DATA(^DD(+N,0,"DIK"))#2
SET X=^("DIK")
SET Y=+N
SET DMAX=^DD("ROU")
WRITE !,"** File "_IBN_" **",!
DO EN^DIKZ
+3 KILL IBN,N,DMAX
+4 QUIT
