- LBRVPOST ;SSI/ALA-Post Library Patch Clean-Up ;[ 04/15/98 3:45 PM ]
- ;;2.5;Library;**2**;Mar 11, 1996
- S %=$$PARCP^XPDUTL("PRE1","PRE")
- I %=0 K % D RC G EXIT
- K X,DIK,DA
- STA N %
- S %=$$NEWCP^XPDUTL("MOVE","MOV^LBRVPOST")
- INDX ;reindex cross-references for File#680.6
- F LBRDI="B","C" K ^LBRY(680.6,LBRDI)
- S DIK="^LBRY(680.6," D IXALL^DIK
- FIL ; File the site into the data files
- S %=$$PARCP^XPDUTL("FILE","PRE"),LBRVY=%
- F LBRDI=680,681,682 D D MES^XPDUTL("File "_LBRDI_" done.") K DA,DR,DIC,DIE
- . S DIC="^LBRY("_LBRDI_",",DA=0
- . S DR=".04////^S X=LBRVY"
- . F S DA=$O(^LBRY(LBRDI,DA)) Q:'DA S DIE=DIC D ^DIE W:DA#100=0 "."
- K DA,DR,DIC,DIE,LBRDI
- S DR=".02////^S X=LBRVY",DIC="^LBRY(680.7,",DIE=DIC,DA=0
- F S DA=$O(^LBRY(680.7,DA)) Q:'DA D ^DIE W:DA#10=0 "."
- K DA,DR,DIC,DIE
- S DR="1////^S X=LBRVY",DIC="^LBRY(680.4,",DIE=DIC,DA=0
- F S DA=$O(^LBRY(680.4,DA)) Q:'DA D ^DIE W:DA#10=0 "."
- K DA,DR,DIC,DIE
- Q
- MOV ; Move data into scratch file if appropriate
- S %=$$PARCP^XPDUTL("PRE1","PRE"),LBRFL=%
- S LBRWSTA=$$PARCP^XPDUTL("STNCD","PRE")
- CV I LBRFL="LEG" D
- . S LBRVDT=$$FMADD^XLFDT(DT,7)
- . S ^XTMP("LBRY",0)=LBRVDT_"^"_DT
- . S ^XTMP("LBRY",LBRWSTA)=LBRWSTA
- . D ^LBRVCONV
- . D RC
- . D MES^XPDUTL("You are now ready to move your data to the primary system.")
- . D MES^XPDUTL("Please move temporary global, ^XTMP(""LBRY"" to correct directory and install LBR*2.5*3.")
- I LBRFL="PRI" D RC
- G EXIT
- RC ; Find bad records
- S DIK="^LBRY(681,",DA=0 W "."
- F S DA=$O(^LBRY(681,DA)) Q:'DA D
- . S TAF=$P(^LBRY(681,DA,0),U,2)
- . I TAF="" D ^DIK Q
- . I '$D(^LBRY(680,TAF)) D ^DIK
- S DIK="^LBRY(682,",DA=0 W "."
- F S DA=$O(^LBRY(682,DA)) Q:'DA D
- . S TAF=$P(^LBRY(682,DA,0),U,2)
- . I TAF="" D ^DIK Q
- . I '$D(^LBRY(680,TAF)) D ^DIK
- S DIK="^LBRY(682.1,",DA="" W "."
- F S DA=$O(^LBRY(682.1,DA)) Q:DA=0 D
- . K ^LBRY(682.1,DA)
- F IND="AA","AC","AD","B","C" K ^LBRY(682.1,IND)
- D IXALL^DIK
- W "."
- REINDX ; re-indexing of all cross-references
- D MES^XPDUTL("I am now re-indexing all cross-references")
- W !
- F J=680,681,682,680.4,680.7,680.3,680.5 S LX="A" F S LX=$O(^LBRY(J,LX)) Q:LX="" K ^LBRY(J,LX)
- F DIK="^LBRY(680,","^LBRY(681,","^LBRY(682,","^LBRY(680.4,","^LBRY(680.7,","^LBRY(680.3,","^LBRY(680.5," D
- . W DIK,! D IXALL^DIK
- Q
- EXIT K DA,DIC,LBRVY,LBRDI,DIE,DR,LFLG,LBRWSTA,LSTN,GSTN,LBRWSTN,LBRFL,CKDA
- K LBRVDT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLBRVPOST 2397 printed Feb 18, 2025@23:36:11 Page 2
- LBRVPOST ;SSI/ALA-Post Library Patch Clean-Up ;[ 04/15/98 3:45 PM ]
- +1 ;;2.5;Library;**2**;Mar 11, 1996
- +2 SET %=$$PARCP^XPDUTL("PRE1","PRE")
- +3 IF %=0
- KILL %
- DO RC
- GOTO EXIT
- +4 KILL X,DIK,DA
- STA NEW %
- +1 SET %=$$NEWCP^XPDUTL("MOVE","MOV^LBRVPOST")
- INDX ;reindex cross-references for File#680.6
- +1 FOR LBRDI="B","C"
- KILL ^LBRY(680.6,LBRDI)
- +2 SET DIK="^LBRY(680.6,"
- DO IXALL^DIK
- FIL ; File the site into the data files
- +1 SET %=$$PARCP^XPDUTL("FILE","PRE")
- SET LBRVY=%
- +2 FOR LBRDI=680,681,682
- Begin DoDot:1
- +3 SET DIC="^LBRY("_LBRDI_","
- SET DA=0
- +4 SET DR=".04////^S X=LBRVY"
- +5 FOR
- SET DA=$ORDER(^LBRY(LBRDI,DA))
- if 'DA
- QUIT
- SET DIE=DIC
- DO ^DIE
- if DA#100=0
- WRITE "."
- End DoDot:1
- DO MES^XPDUTL("File "_LBRDI_" done.")
- KILL DA,DR,DIC,DIE
- +6 KILL DA,DR,DIC,DIE,LBRDI
- +7 SET DR=".02////^S X=LBRVY"
- SET DIC="^LBRY(680.7,"
- SET DIE=DIC
- SET DA=0
- +8 FOR
- SET DA=$ORDER(^LBRY(680.7,DA))
- if 'DA
- QUIT
- DO ^DIE
- if DA#10=0
- WRITE "."
- +9 KILL DA,DR,DIC,DIE
- +10 SET DR="1////^S X=LBRVY"
- SET DIC="^LBRY(680.4,"
- SET DIE=DIC
- SET DA=0
- +11 FOR
- SET DA=$ORDER(^LBRY(680.4,DA))
- if 'DA
- QUIT
- DO ^DIE
- if DA#10=0
- WRITE "."
- +12 KILL DA,DR,DIC,DIE
- +13 QUIT
- MOV ; Move data into scratch file if appropriate
- +1 SET %=$$PARCP^XPDUTL("PRE1","PRE")
- SET LBRFL=%
- +2 SET LBRWSTA=$$PARCP^XPDUTL("STNCD","PRE")
- CV IF LBRFL="LEG"
- Begin DoDot:1
- +1 SET LBRVDT=$$FMADD^XLFDT(DT,7)
- +2 SET ^XTMP("LBRY",0)=LBRVDT_"^"_DT
- +3 SET ^XTMP("LBRY",LBRWSTA)=LBRWSTA
- +4 DO ^LBRVCONV
- +5 DO RC
- +6 DO MES^XPDUTL("You are now ready to move your data to the primary system.")
- +7 DO MES^XPDUTL("Please move temporary global, ^XTMP(""LBRY"" to correct directory and install LBR*2.5*3.")
- End DoDot:1
- +8 IF LBRFL="PRI"
- DO RC
- +9 GOTO EXIT
- RC ; Find bad records
- +1 SET DIK="^LBRY(681,"
- SET DA=0
- WRITE "."
- +2 FOR
- SET DA=$ORDER(^LBRY(681,DA))
- if 'DA
- QUIT
- Begin DoDot:1
- +3 SET TAF=$PIECE(^LBRY(681,DA,0),U,2)
- +4 IF TAF=""
- DO ^DIK
- QUIT
- +5 IF '$DATA(^LBRY(680,TAF))
- DO ^DIK
- End DoDot:1
- +6 SET DIK="^LBRY(682,"
- SET DA=0
- WRITE "."
- +7 FOR
- SET DA=$ORDER(^LBRY(682,DA))
- if 'DA
- QUIT
- Begin DoDot:1
- +8 SET TAF=$PIECE(^LBRY(682,DA,0),U,2)
- +9 IF TAF=""
- DO ^DIK
- QUIT
- +10 IF '$DATA(^LBRY(680,TAF))
- DO ^DIK
- End DoDot:1
- +11 SET DIK="^LBRY(682.1,"
- SET DA=""
- WRITE "."
- +12 FOR
- SET DA=$ORDER(^LBRY(682.1,DA))
- if DA=0
- QUIT
- Begin DoDot:1
- +13 KILL ^LBRY(682.1,DA)
- End DoDot:1
- +14 FOR IND="AA","AC","AD","B","C"
- KILL ^LBRY(682.1,IND)
- +15 DO IXALL^DIK
- +16 WRITE "."
- REINDX ; re-indexing of all cross-references
- +1 DO MES^XPDUTL("I am now re-indexing all cross-references")
- +2 WRITE !
- +3 FOR J=680,681,682,680.4,680.7,680.3,680.5
- SET LX="A"
- FOR
- SET LX=$ORDER(^LBRY(J,LX))
- if LX=""
- QUIT
- KILL ^LBRY(J,LX)
- +4 FOR DIK="^LBRY(680,","^LBRY(681,","^LBRY(682,","^LBRY(680.4,","^LBRY(680.7,","^LBRY(680.3,","^LBRY(680.5,"
- Begin DoDot:1
- +5 WRITE DIK,!
- DO IXALL^DIK
- End DoDot:1
- +6 QUIT
- EXIT KILL DA,DIC,LBRVY,LBRDI,DIE,DR,LFLG,LBRWSTA,LSTN,GSTN,LBRWSTN,LBRFL,CKDA
- +1 KILL LBRVDT
- +2 QUIT