IBDFUTI ;ALB/AAS - Installation utilitie Re-Compile Templates/x-refs ; 1/31/92
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
; ******* 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 IBDX="IBCzzz"
F IBI=1:1 S IBDX=$O(@IBFILE@("B",IBDX)) Q:IBDX=""!($E(IBDX,1,3)'="IBD") S Y=+$O(^(IBDX,0)) D
.I $D(@IBFILE@(Y,"ROUOLD")),^("ROUOLD")]"",$D(^(0)) S (IBEMP,Y)=Y,X=$P(^("ROUOLD"),"^"),IB0=^(0) D COMP
;
ENQ K IBROU,IB0,IBDX,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 DIR(0)="Y",DIR("A")="Re-compile all AICS 'IBD' 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 IBD '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=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[HIBDFUTI 1803 printed Apr 09, 2024@21:42:41 Page 2
IBDFUTI ;ALB/AAS - Installation utilitie Re-Compile Templates/x-refs ; 1/31/92
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
+3 ; ******* DO NOT MAP THIS ROUTINE *******
+4 QUIT
+5 ;
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 IBDX="IBCzzz"
+10 FOR IBI=1:1
SET IBDX=$ORDER(@IBFILE@("B",IBDX))
if IBDX=""!($EXTRACT(IBDX,1,3)'="IBD")
QUIT
SET Y=+$ORDER(^(IBDX,0))
Begin DoDot:1
+11 IF $DATA(@IBFILE@(Y,"ROUOLD"))
IF ^("ROUOLD")]""
IF $DATA(^(0))
SET (IBEMP,Y)=Y
SET X=$PIECE(^("ROUOLD"),"^")
SET IB0=^(0)
DO COMP
End DoDot:1
+12 ;
ENQ KILL IBROU,IB0,IBDX,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 SET DIR(0)="Y"
SET DIR("A")="Re-compile all AICS 'IBD' templates and cross references"
+2 SET DIR("?",1)="Yes to re-compile"
SET DIR("?",2)="No to stop recompilation process"
SET DIR("?")=" "
+3 DO ^DIR
KILL DIR
if 'Y
GOTO ALLQ
+4 DO DIEZ
WRITE !!
+5 DO DIPZ
WRITE !!
+6 DO DIKZ
+7 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 IBD '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=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
