Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LBRVPOST

LBRVPOST.m

Go to the documentation of this file.
  1. LBRVPOST ;SSI/ALA-Post Library Patch Clean-Up ;[ 04/15/98 3:45 PM ]
  1. ;;2.5;Library;**2**;Mar 11, 1996
  1. S %=$$PARCP^XPDUTL("PRE1","PRE")
  1. I %=0 K % D RC G EXIT
  1. K X,DIK,DA
  1. STA N %
  1. S %=$$NEWCP^XPDUTL("MOVE","MOV^LBRVPOST")
  1. INDX ;reindex cross-references for File#680.6
  1. F LBRDI="B","C" K ^LBRY(680.6,LBRDI)
  1. S DIK="^LBRY(680.6," D IXALL^DIK
  1. FIL ; File the site into the data files
  1. S %=$$PARCP^XPDUTL("FILE","PRE"),LBRVY=%
  1. F LBRDI=680,681,682 D D MES^XPDUTL("File "_LBRDI_" done.") K DA,DR,DIC,DIE
  1. . S DIC="^LBRY("_LBRDI_",",DA=0
  1. . S DR=".04////^S X=LBRVY"
  1. . F S DA=$O(^LBRY(LBRDI,DA)) Q:'DA S DIE=DIC D ^DIE W:DA#100=0 "."
  1. K DA,DR,DIC,DIE,LBRDI
  1. S DR=".02////^S X=LBRVY",DIC="^LBRY(680.7,",DIE=DIC,DA=0
  1. F S DA=$O(^LBRY(680.7,DA)) Q:'DA D ^DIE W:DA#10=0 "."
  1. K DA,DR,DIC,DIE
  1. S DR="1////^S X=LBRVY",DIC="^LBRY(680.4,",DIE=DIC,DA=0
  1. F S DA=$O(^LBRY(680.4,DA)) Q:'DA D ^DIE W:DA#10=0 "."
  1. K DA,DR,DIC,DIE
  1. Q
  1. MOV ; Move data into scratch file if appropriate
  1. S %=$$PARCP^XPDUTL("PRE1","PRE"),LBRFL=%
  1. S LBRWSTA=$$PARCP^XPDUTL("STNCD","PRE")
  1. CV I LBRFL="LEG" D
  1. . S LBRVDT=$$FMADD^XLFDT(DT,7)
  1. . S ^XTMP("LBRY",0)=LBRVDT_"^"_DT
  1. . S ^XTMP("LBRY",LBRWSTA)=LBRWSTA
  1. . D ^LBRVCONV
  1. . D RC
  1. . D MES^XPDUTL("You are now ready to move your data to the primary system.")
  1. . D MES^XPDUTL("Please move temporary global, ^XTMP(""LBRY"" to correct directory and install LBR*2.5*3.")
  1. I LBRFL="PRI" D RC
  1. G EXIT
  1. RC ; Find bad records
  1. S DIK="^LBRY(681,",DA=0 W "."
  1. F S DA=$O(^LBRY(681,DA)) Q:'DA D
  1. . S TAF=$P(^LBRY(681,DA,0),U,2)
  1. . I TAF="" D ^DIK Q
  1. . I '$D(^LBRY(680,TAF)) D ^DIK
  1. S DIK="^LBRY(682,",DA=0 W "."
  1. F S DA=$O(^LBRY(682,DA)) Q:'DA D
  1. . S TAF=$P(^LBRY(682,DA,0),U,2)
  1. . I TAF="" D ^DIK Q
  1. . I '$D(^LBRY(680,TAF)) D ^DIK
  1. S DIK="^LBRY(682.1,",DA="" W "."
  1. F S DA=$O(^LBRY(682.1,DA)) Q:DA=0 D
  1. . K ^LBRY(682.1,DA)
  1. F IND="AA","AC","AD","B","C" K ^LBRY(682.1,IND)
  1. D IXALL^DIK
  1. W "."
  1. REINDX ; re-indexing of all cross-references
  1. D MES^XPDUTL("I am now re-indexing all cross-references")
  1. W !
  1. 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)
  1. F DIK="^LBRY(680,","^LBRY(681,","^LBRY(682,","^LBRY(680.4,","^LBRY(680.7,","^LBRY(680.3,","^LBRY(680.5," D
  1. . W DIK,! D IXALL^DIK
  1. Q
  1. EXIT K DA,DIC,LBRVY,LBRDI,DIE,DR,LFLG,LBRWSTA,LSTN,GSTN,LBRWSTN,LBRFL,CKDA
  1. K LBRVDT
  1. Q