- 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 Feb 19, 2025@00:14:26 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