- 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
- 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
