- 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
