TIUPS79 ; SLC/JM - Post-install for TIU*1*79 ;04:18 PM 20 Jan 2000
;;1.0;TEXT INTEGRATION UTILITIES;**79**;Jun 20, 1997
INSTALL ; Main entry point for install
N DOCOUNT,XPDIDTOT S DOCOUNT=1
D MAIN
D BUILDAES ; Build new AES cross-reference
Q
MAIN ; Main entry point for manual call
N IDX,USER,CNT
; First reorder the ASAVE XRef in ^TMP
K ^TMP("TIU79",$J)
S USER=0
F S USER=$O(^TIU(8925,"ASAVE",USER)) Q:'USER D
.S IDX=0
.F S IDX=$O(^TIU(8925,"ASAVE",USER,IDX)) Q:'IDX D
..S ^TMP("TIU79",$J,IDX,USER)=""
S CNT=0
I $D(DOCOUNT) D
.D COUNT(.CNT,-2),COUNT(.CNT,"-0;")
.S XPDIDTOT=CNT,CNT=0
D FIX(.CNT,-2),FIX(.CNT,"-0;")
K ^TMP("TIU79",$J)
Q
;
COUNT(CNT,FRSTBASE) ;Count all the -1 entries in "G" XRef
N BASE,IDX
S BASE=FRSTBASE
F S BASE=$O(^TIU(8925,"G",BASE)) Q:$$BADBASE() D
.S IDX=0
.F S IDX=$O(^TIU(8925,"G",BASE,IDX)) Q:'IDX S CNT=CNT+1
Q
;
FIX(CNT,FRSTBASE) ;Fix 1405 fields by searching the "G" XRef for -1
N BASE,IDX,USER
S BASE=FRSTBASE
F S BASE=$O(^TIU(8925,"G",BASE)) Q:$$BADBASE() D
.S IDX=0
.F S IDX=$O(^TIU(8925,"G",BASE,IDX)) Q:'IDX D
..S USER=0
..F S USER=$O(^TMP("TIU79",$J,IDX,USER)) Q:'USER D
...K ^TIU(8925,"ASAVE",USER,IDX)
..N DIE,DA,DR
..S DIE=8925
..S DA=IDX
..S DR="1405///@"
..D ^DIE
..I $D(DOCOUNT) D
...S CNT=CNT+1
...D UPDATE^XPDID(CNT)
Q
BADBASE() ; Returns TRUE if at the end of this part of the "G" XRef
N BAD
S BAD=0
I FRSTBASE=-2 D I 1
.I BASE'=-1,BASE'=0 S BAD=1
E I (+BASE)'=-1 S BAD=1
Q BAD
BUILDAES ; Build "AES" index on Multi-signature file
N DA,DIK,CNT,XPDIDTOT
; If the index exists, don't rebuild it
Q:+$O(^TIU(8925.7,"AES",0))
S DIK="^TIU(8925.7,",DIK(1)=".01^AES",(CNT,DA)=0
D BMES^XPDUTL(" BUILDING NEW ""AES"" CROSS-REFERENCE ON FILE 8925.7")
S XPDIDTOT=$P(^TIU(8925.1,0),U,4)
D UPDATE^XPDID(0)
F S DA=$O(^TIU(8925.7,DA)) Q:+DA'>0 D
. D EN1^DIK
. S CNT=CNT+1
. D:'(CNT#10) UPDATE^XPDID(CNT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPS79 1997 printed Apr 09, 2024@21:46:03 Page 2
TIUPS79 ; SLC/JM - Post-install for TIU*1*79 ;04:18 PM 20 Jan 2000
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**79**;Jun 20, 1997
INSTALL ; Main entry point for install
+1 NEW DOCOUNT,XPDIDTOT
SET DOCOUNT=1
+2 DO MAIN
+3 ; Build new AES cross-reference
DO BUILDAES
+4 QUIT
MAIN ; Main entry point for manual call
+1 NEW IDX,USER,CNT
+2 ; First reorder the ASAVE XRef in ^TMP
+3 KILL ^TMP("TIU79",$JOB)
+4 SET USER=0
+5 FOR
SET USER=$ORDER(^TIU(8925,"ASAVE",USER))
if 'USER
QUIT
Begin DoDot:1
+6 SET IDX=0
+7 FOR
SET IDX=$ORDER(^TIU(8925,"ASAVE",USER,IDX))
if 'IDX
QUIT
Begin DoDot:2
+8 SET ^TMP("TIU79",$JOB,IDX,USER)=""
End DoDot:2
End DoDot:1
+9 SET CNT=0
+10 IF $DATA(DOCOUNT)
Begin DoDot:1
+11 DO COUNT(.CNT,-2)
DO COUNT(.CNT,"-0;")
+12 SET XPDIDTOT=CNT
SET CNT=0
End DoDot:1
+13 DO FIX(.CNT,-2)
DO FIX(.CNT,"-0;")
+14 KILL ^TMP("TIU79",$JOB)
+15 QUIT
+16 ;
COUNT(CNT,FRSTBASE) ;Count all the -1 entries in "G" XRef
+1 NEW BASE,IDX
+2 SET BASE=FRSTBASE
+3 FOR
SET BASE=$ORDER(^TIU(8925,"G",BASE))
if $$BADBASE()
QUIT
Begin DoDot:1
+4 SET IDX=0
+5 FOR
SET IDX=$ORDER(^TIU(8925,"G",BASE,IDX))
if 'IDX
QUIT
SET CNT=CNT+1
End DoDot:1
+6 QUIT
+7 ;
FIX(CNT,FRSTBASE) ;Fix 1405 fields by searching the "G" XRef for -1
+1 NEW BASE,IDX,USER
+2 SET BASE=FRSTBASE
+3 FOR
SET BASE=$ORDER(^TIU(8925,"G",BASE))
if $$BADBASE()
QUIT
Begin DoDot:1
+4 SET IDX=0
+5 FOR
SET IDX=$ORDER(^TIU(8925,"G",BASE,IDX))
if 'IDX
QUIT
Begin DoDot:2
+6 SET USER=0
+7 FOR
SET USER=$ORDER(^TMP("TIU79",$JOB,IDX,USER))
if 'USER
QUIT
Begin DoDot:3
+8 KILL ^TIU(8925,"ASAVE",USER,IDX)
End DoDot:3
+9 NEW DIE,DA,DR
+10 SET DIE=8925
+11 SET DA=IDX
+12 SET DR="1405///@"
+13 DO ^DIE
+14 IF $DATA(DOCOUNT)
Begin DoDot:3
+15 SET CNT=CNT+1
+16 DO UPDATE^XPDID(CNT)
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
BADBASE() ; Returns TRUE if at the end of this part of the "G" XRef
+1 NEW BAD
+2 SET BAD=0
+3 IF FRSTBASE=-2
Begin DoDot:1
+4 IF BASE'=-1
IF BASE'=0
SET BAD=1
End DoDot:1
IF 1
+5 IF '$TEST
IF (+BASE)'=-1
SET BAD=1
+6 QUIT BAD
BUILDAES ; Build "AES" index on Multi-signature file
+1 NEW DA,DIK,CNT,XPDIDTOT
+2 ; If the index exists, don't rebuild it
+3 if +$ORDER(^TIU(8925.7,"AES",0))
QUIT
+4 SET DIK="^TIU(8925.7,"
SET DIK(1)=".01^AES"
SET (CNT,DA)=0
+5 DO BMES^XPDUTL(" BUILDING NEW ""AES"" CROSS-REFERENCE ON FILE 8925.7")
+6 SET XPDIDTOT=$PIECE(^TIU(8925.1,0),U,4)
+7 DO UPDATE^XPDID(0)
+8 FOR
SET DA=$ORDER(^TIU(8925.7,DA))
if +DA'>0
QUIT
Begin DoDot:1
+9 DO EN1^DIK
+10 SET CNT=CNT+1
+11 if '(CNT#10)
DO UPDATE^XPDID(CNT)
End DoDot:1
+12 QUIT
