DIFROMS ;SFISC/DCL-DIFROM SERVER DD/DATA IN/OUT ;09:47 AM 19 Jan 1995
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
Q
DDOUT(DIFRFILE,DIFRFLG,DIFRFIA,DIFRTA,DIFRMSGR) ; DD OUT TO TARGET ARRAY
;FILE,FLAGS,FIA_ARRAY,TARGET_ARRAY,MSG_ROOT
I '$D(DIQUIET) N DIQUIET S DIQUIET=1
I '$D(DIFM) N DIFM S DIFM=1
I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
S DIFRFIA=$G(DIFRFIA) S:DIFRFIA="" DIFRFIA=$NA(@DIFRTA@("FIA"))
D EN^DIFROMS1
G EXIT
Q
DDIN(DIFRFILE,DIFRFLG,DIFRFIA,DIFRSA,DIFRMSGR) ; DD IN FROM SOURCE ARRAY
;FILE,FLAGS,FIA_ARRAY,SOURCE_ARRAY,MSG_ROOT
I '$D(DIQUIET) N DIQUIET S DIQUIET=1
I '$D(DIFM) N DIFM S DIFM=1
I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
S DIFRFIA=$G(DIFRFIA) S:DIFRFIA="" DIFRFIA=$NA(@DIFRSA@("FIA"))
N DIOVRD S DIOVRD=1
D EN^DIFROMS2
G EXIT
Q
DATAOUT(DIFRFILE,DIFRFLG,DIFRFIA,DIFRTA,DIFRMSGR) ; DATA OUT
;FILE,FLAGS,FIA_ROOT,TARGET_ARRAY_ROOT,MSG_ROOT
I '$D(DIQUIET) N DIQUIET S DIQUIET=1
I '$D(DIFM) N DIFM S DIFM=1
I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
S DIFRFIA=$G(DIFRFIA) S:DIFRFIA="" DIFRFIA=$NA(@DIFRTA@("FIA"))
N DIFRERRC
D EN^DIFROMS3
I $G(DIFRERRC) S DIERR=DIFRERRC
G EXIT
Q
DATAIN(DIFRFILE,DIFRFLG,DIFRFIA,DIFRSA,DIFRMSGR) ; DATA IN
;FILE,FLAGS,FIAROOT,SOURCE_ARRAY,MSG_ROOT
I '$D(DIQUIET) N DIQUIET S DIQUIET=1
I '$D(DIFM) N DIFM S DIFM=1
I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
S DIFRFIA=$G(DIFRFIA) S:DIFRFIA="" DIFRFIA=$NA(@DIFRSA@("FIA"))
N DIOVRD S DIOVRD=1
D EN^DIFROMS4
G EXIT
Q
;
EXIT I $G(DIFRMSGR)]"" D CALLOUT^DIEFU(DIFRMSGR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIFROMS 1903 printed Dec 13, 2024@02:48:11 Page 2
DIFROMS ;SFISC/DCL-DIFROM SERVER DD/DATA IN/OUT ;09:47 AM 19 Jan 1995
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 QUIT
DDOUT(DIFRFILE,DIFRFLG,DIFRFIA,DIFRTA,DIFRMSGR) ; DD OUT TO TARGET ARRAY
+1 ;FILE,FLAGS,FIA_ARRAY,TARGET_ARRAY,MSG_ROOT
+2 IF '$DATA(DIQUIET)
NEW DIQUIET
SET DIQUIET=1
+3 IF '$DATA(DIFM)
NEW DIFM
SET DIFM=1
+4 IF $GET(U)'="^"!($GET(DT)'>0)!($GET(DTIME)'>0)!('$DATA(DUZ))
DO DT^DICRW
+5 SET DIFRFIA=$GET(DIFRFIA)
if DIFRFIA=""
SET DIFRFIA=$NAME(@DIFRTA@("FIA"))
+6 DO EN^DIFROMS1
+7 GOTO EXIT
+8 QUIT
DDIN(DIFRFILE,DIFRFLG,DIFRFIA,DIFRSA,DIFRMSGR) ; DD IN FROM SOURCE ARRAY
+1 ;FILE,FLAGS,FIA_ARRAY,SOURCE_ARRAY,MSG_ROOT
+2 IF '$DATA(DIQUIET)
NEW DIQUIET
SET DIQUIET=1
+3 IF '$DATA(DIFM)
NEW DIFM
SET DIFM=1
+4 IF $GET(U)'="^"!($GET(DT)'>0)!($GET(DTIME)'>0)!('$DATA(DUZ))
DO DT^DICRW
+5 SET DIFRFIA=$GET(DIFRFIA)
if DIFRFIA=""
SET DIFRFIA=$NAME(@DIFRSA@("FIA"))
+6 NEW DIOVRD
SET DIOVRD=1
+7 DO EN^DIFROMS2
+8 GOTO EXIT
+9 QUIT
DATAOUT(DIFRFILE,DIFRFLG,DIFRFIA,DIFRTA,DIFRMSGR) ; DATA OUT
+1 ;FILE,FLAGS,FIA_ROOT,TARGET_ARRAY_ROOT,MSG_ROOT
+2 IF '$DATA(DIQUIET)
NEW DIQUIET
SET DIQUIET=1
+3 IF '$DATA(DIFM)
NEW DIFM
SET DIFM=1
+4 IF $GET(U)'="^"!($GET(DT)'>0)!($GET(DTIME)'>0)!('$DATA(DUZ))
DO DT^DICRW
+5 SET DIFRFIA=$GET(DIFRFIA)
if DIFRFIA=""
SET DIFRFIA=$NAME(@DIFRTA@("FIA"))
+6 NEW DIFRERRC
+7 DO EN^DIFROMS3
+8 IF $GET(DIFRERRC)
SET DIERR=DIFRERRC
+9 GOTO EXIT
+10 QUIT
DATAIN(DIFRFILE,DIFRFLG,DIFRFIA,DIFRSA,DIFRMSGR) ; DATA IN
+1 ;FILE,FLAGS,FIAROOT,SOURCE_ARRAY,MSG_ROOT
+2 IF '$DATA(DIQUIET)
NEW DIQUIET
SET DIQUIET=1
+3 IF '$DATA(DIFM)
NEW DIFM
SET DIFM=1
+4 IF $GET(U)'="^"!($GET(DT)'>0)!($GET(DTIME)'>0)!('$DATA(DUZ))
DO DT^DICRW
+5 SET DIFRFIA=$GET(DIFRFIA)
if DIFRFIA=""
SET DIFRFIA=$NAME(@DIFRSA@("FIA"))
+6 NEW DIOVRD
SET DIOVRD=1
+7 DO EN^DIFROMS4
+8 GOTO EXIT
+9 QUIT
+10 ;
EXIT IF $GET(DIFRMSGR)]""
DO CALLOUT^DIEFU(DIFRMSGR)
+1 QUIT
