IBDFUTI.m

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

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