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

DIFROMS4.m

Go to the documentation of this file.
  1. DIFROMS4 ;SFISC/DCL- DATA FROM DISTRIBUTION ARRAY ;5/24/00 15:22
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. Q
  1. EN ;
  1. I '$D(@DIFRFIA) D ERR(2) Q
  1. ;N DIFRFILP S DIFRFILP=$D(DIFRFILP)#2
  1. N %,%H,A,B,D,D0,D1,DA,DDF,DDT,DFL,DFN,DFR,DIC,DIFL,DIIX,DIK,DINUM,DIU
  1. N DKP,DMRG,DTL,DTN,DTO,I,V,W,X,Y,Z
  1. G:$G(DIFRFILE) FILE
  1. S DIFRFILE=0 F S DIFRFILE=$O(@DIFRFIA@(DIFRFILE)) Q:DIFRFILE'>0 D FILE
  1. Q
  1. FCHK I '$D(@DIFRFIA@(DIFRFILE)) D ERR(5) Q ; * * * PHASING OUT * * *
  1. FILE N DIFRDA,DIFRND0,DIFROOT,DIFR01,DIFR02,DIFRRLR,DIFRFRV
  1. N DIFRDKP,DIFRDKPD,DIFRDKPR,DIFRDKPS
  1. D KILL
  1. I '$D(@DIFRFIA) D ERR(2) Q
  1. I $G(@DIFRFIA@(DIFRFILE,DIFRFILE)) D Q
  1. .N DIFRERR S DIFRERR(1)=DIFRFILE
  1. .D BLD^DIALOG(9515,.DIFRERR)
  1. .Q
  1. S DIFROOT=@DIFRFIA@(DIFRFILE,0),DIFRDA=0
  1. S DIFR01=@DIFRFIA@(DIFRFILE,0,1),DIFR02=$G(^(2))
  1. I $P(DIFR02,"^",8)="" S $P(DIFR02,"^",8)=$$TL^DIFROMSP(DIFRFILE,"",DIFRSA)
  1. S DIFRRLR=$G(@DIFRFIA@(DIFRFILE,0,"RLRI")) ; * * * phasing out * * *
  1. S:DIFRRLR="" DIFRRLR=$NA(@DIFRSA@("DATA",DIFRFILE))
  1. I $D(@DIFRRLR)'>9 D ERR(4) Q
  1. ;
  1. ; Recover from a failure in Replace Mode RE-INSTALL on target system
  1. I $D(@DIFRSA@("TMP")) D K @DIFRSA@("TMP")
  1. .S (D,DDF(1),DDT(0))=DIFRFILE
  1. .S DTO=0,DMRG=1,DTO(0)=DIFROOT,DKP=$S($TR($P(DIFR01,"^",8),"O","o")="o":0,1:1)
  1. .S DFR(1)=$$OREF^DILF(DIFRSA)_"""TMP"",DIFRFILE,D0,"
  1. .S D0=$O(@DIFRSA@("TMP",DIFRFILE,0)) Q:'$D(^(D0,0)) S Z=^(0)
  1. .D I^DITR,REINDEX
  1. .D KILL Q
  1. ;
  1. F S DIFRDA=$O(@DIFRRLR@(DIFRDA)) Q:DIFRDA'>0 D
  1. .S (D,DDF(1),DDT(0))=DIFRFILE
  1. .S DTO=0,DMRG=1,DTO(0)=DIFROOT
  1. .S DFR(1)=$$OREF^DILF($NA(@DIFRSA@("DATA")))_"DDF(1),D0,"
  1. .S DKP=$S($TR($P(DIFR01,"^",8),"O","o")="o":0,1:1)
  1. .S (DIFRDKPD,DIFRDKPR)=$S($TR($P(DIFR01,"^",8),"R","r")="r":1,1:0)
  1. .S (DIFRND0,DIFRDKP)=0
  1. .S:+DIFR02 (DIFRDKPD,DIFRDKPR)=0 ;if file is new Replace not needed
  1. .S DIFRDKPS=$P(DIFR02,"^",8) ;save local data
  1. .S DIFRFRV=$TR($P(DIFR01,"^",5),"Y","y")="y"
  1. .S D0=DIFRDA,Z=@DIFRSA@("DATA",DIFRFILE,DIFRDA,0)
  1. .K @DIFRSA@("TMP")
  1. .D I^DITR,REINDEX
  1. .; If no data in local fields, quit.
  1. .I $D(@DIFRSA@("TMP"))'>9 D KILL Q
  1. .; restore data in local fields from old entry
  1. .S DIFRDKP=1,DIFRFRV=0
  1. .K DFR,DA,D0
  1. .;S DFR(1)="^TMP(""DIFRDKPD"",$J,DIFRFILE,D0,"
  1. .S DFR(1)=$$OREF^DILF(DIFRSA)_"""TMP"",DIFRFILE,D0,"
  1. .S D0=$O(@DIFRSA@("TMP",DIFRFILE,0)) Q:'$D(^(D0,0)) S Z=^(0)
  1. .D I^DITR,REINDEX,KILL
  1. .Q
  1. K @DIFRSA@("TMP")
  1. ; DO A CHECK HERE LIKE Q:'$D(DIFQ) LATER ON
  1. Q
  1. ;
  1. KILL K %,%H,A,B,D,D0,D1,DA,DDF,DDT,DFL,DFN,DFR,DIC,DIFL,DIIX,DIK,DINUM,DIU
  1. K DKP,DMRG,DTL,DTN,DTO,I,V,W,X,Y,Z Q
  1. ;
  1. REINDEX ; REINDEX ENTRY
  1. Q:DIFRND0'>0
  1. N DIK,DA S DA=DIFRND0,DIK=DIFROOT,DIK(0)="AB"
  1. D IX1^DIK Q
  1. ;
  1. ERR(X) N Y S Y=$P($T(ERR+X),";",5) Q:'Y D BLD^DIALOG(Y) Q
  1. ;;FIA Node Is Set To "No Data";1;9509
  1. ;;FIA Array Does Not Exist;2;9501
  1. ;;;3;
  1. ;;Records Do Not Exist;4;9510
  1. ;;FIA File Number Invalid;5;9502
  1. ;;Partial DD. No sending of data allowed for file |1|;1;9515