DIEFU ;SF/DPC-FILER UTILITIES ;29OCT2015
;;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.
;
INIZE ;
N %,X,%H,DIE,DICS,DIC,%DT,DIK,%Y,%X,%D,%M,%I
D DTNOLF^DICRW
D CLEAN
Q
CLEAN ;
K DIRUT,DIROUT,DUOUT,DTOUT
;K ^TMP("DIERR",$J),^TMP("DIMSG",$J),^TMP("DIHELP",$J)
I $D(^TMP("DIERR",$J)) KILL ^($J)
I $D(^TMP("DIMSG",$J)) KILL ^($J)
I $D(^TMP("DIHELP",$J)) KILL ^($J)
K DIERR,DIHELP,DIMSG
Q
;
CALLOUT(DIOUTAR) ;
I '$$VROOT(DIOUTAR) Q
I $D(DIERR) D
. S @DIOUTAR@("DIERR")=DIERR
. M @DIOUTAR@("DIERR")=^TMP("DIERR",$J)
. K ^TMP("DIERR",$J)
. Q
I $D(DIHELP) D
. S @DIOUTAR@("DIHELP")=DIHELP
. M @DIOUTAR@("DIHELP")=^TMP("DIHELP",$J)
. K ^TMP("DIHELP",$J)
. Q
I $D(DIMSG) D
. S @DIOUTAR@("DIMSG")=DIMSG
. M @DIOUTAR@("DIMSG")=^TMP("DIMSG",$J)
. K ^TMP("DIMSG",$J)
. Q
Q
;
IEN(DIEFDA) ;
IENX ;
I '$D(DIEFDA) Q 0
N I,DIEFIEN S (I,DIEFIEN)="",DIEFDA(0)=$G(DIEFDA)
F S I=$O(DIEFDA(I)) Q:I="" S DIEFIEN=DIEFIEN_DIEFDA(I)_","
K DIEFDA(0)
Q DIEFIEN
;
DA(DAIEN,DATARG) ;
DAX ;
K DATARG N I
F I=1:1:$L(DAIEN,",")-1 S DATARG(I-1)=$P(DAIEN,",",I)
I $D(DATARG(0)) S DATARG=DATARG(0) K DATARG(0)
Q
;
VROOT(DIEFAR) ;
I DIEFAR'["(" Q 1
I $E(DIEFAR,$L(DIEFAR))=")",$F(DIEFAR,")")>($F(DIEFAR,"(")+1) Q 1
D BLD^DIALOG(202,"array root")
Q 0
;
VFILE(F,FLAG) ;
VFILEX ;
I $P($G(^DD(F,.01,0)),U,2)]"",$P(^(0),U,2)'["W" Q 1
I $G(FLAG)["D" N P S P("FILE")=F D BLD^DIALOG(401,.P,.P)
Q 0
;
VENTRY(DIEFF,DIEFIEN,DIEFFLG) ;
N DIEFROOT,DIEFDA
S DIEFFLG=$G(DIEFFLG),DIEFDA=$P(DIEFIEN,",")
S DIEFROOT=$$ROOT^DIQGU(DIEFF,DIEFIEN,1,$S(DIEFFLG["D":1,1:0)) Q:DIEFROOT="" 0
I $P($G(@DIEFROOT@(DIEFDA,0)),"^",1)="" D Q 0
. I DIEFFLG["D" N DIEFP S DIEFP("FILE")=DIEFF,DIEFP("IENS")=DIEFIEN D BLD^DIALOG(601,"",.DIEFP)
I DIEFFLG["9" Q:'$$VMINUS9(DIEFF,DIEFIEN,DIEFFLG) 0
Q 1
;
VMINUS9(DIEFF,DIEFIEN,DIEFFLG) ;
N DIEFTOP,DIEFROOT S DIEFFLG=$G(DIEFFLG)
S DIEFTOP=$P(DIEFIEN,",",$L(DIEFIEN,",")-1),DIEFROOT=$$ROOT^DIQGU($$FNO^DILIBF(DIEFF),.DIEFTOP,1,$S(DIEFFLG["D":1,1:0))
Q:DIEFROOT="" 0
I $D(@DIEFROOT@(DIEFTOP,-9)) D Q 0
. I DIEFFLG["D" N DIEFP S DIEFP("FILE")=DIEFF,DIEFP("IENS")=DIEFIEN D BLD^DIALOG(602,"",.DIEFP)
Q 1
;
CHKFLD(DIEFF,DIEFFLD) ;
I DIEFFLD'=+DIEFFLD S DIEFFLD=$$FLDNUM^DIEF1(DIEFF,DIEFFLD) Q:'DIEFFLD 0
I '$$VFIELD(DIEFF,DIEFFLD,"D") Q 0
Q DIEFFLD
;
VFIELD(F,FLD,FLAG) ;
VFIELDX ;
I $D(^DD(F,FLD)) Q 1
I $G(FLAG)["D" N P S (P(1),P("FIELD"))=FLD,P("FILE")=F D BLD^DIALOG(501,.P,.P)
Q 0
;
DT(DIEFDT,DIEFX,DIEFY,DIEFDT0,DIOUTAR) ;
DTX ;
I '$D(DIQUIET) N DIQUIET S DIQUIET=1
I '$D(DIFM) N DIFM S DIFM=1 D INIZE
N %DT,X,Y
S DIEFDT=$G(DIEFDT)
I $G(DIEFX)="" D BLD^DIALOG(202,"date being converted") G DTOUT
I '$$VERFLG^DIEFU(DIEFDT,"FMNPRSTXEeI") G DTOUT
I DIEFX?."?" D DT^DIEH1(DIEFDT) S DIEFY=-1 G DTOUT
S %DT=DIEFDT,X=DIEFX S:$G(DIEFDT0)]"" %DT(0)=DIEFDT0 D ^%DT S DIEFY=Y
I DIEFY=-1 D:DIEFDT'["e" G DTOUT
. N DIEFP
. S DIEFP(1)=DIEFX,DIEFP(2)="date/time"
. D BLD^DIALOG(330,.DIEFP,.DIEFP)
I DIEFDT["E" D DD^%DT S DIEFY(0)=Y
DTOUT I $G(DIOUTAR)]"" D CALLOUT^DIEFU(DIOUTAR)
Q
;
VERFLG(FLG,GDFLGS) ;
N EI
S EI=$TR(FLG,GDFLGS,"")
I EI="" Q 1
D BLD^DIALOG(301,EI,EI)
Q 0
;
XA(DIEFF,DIEFIEN,DIEFFLD,DIEFNVAL,DIEFOVAL) ;
N DA,DIEFCNOD,DOREPL
S DIEFNVAL=$G(DIEFNVAL),DIEFOVAL=$G(DIEFOVAL)
Q:DIEFNVAL=DIEFOVAL
D DA(DIEFIEN,.DA)
D XRFAUD^DIEF
Q
;
FILENM(F) ;
N NM
S NM=$$FILENAME^DIALOGZ($$FNO^DILIBF(F)) ;**CCO/NI GET FILE NAME
;I NM="" <DO ERROR>
Q NM
;
FLDNM(F,FLD) ;
N NM,UP
S NM=$$LABEL^DIALOGZ(F,FLD) ;**CCO/NI GET FIELD LABEL
F S UP=$G(^DD(F,0,"UP")) Q:'UP D
. S NM=NM_" in "_$P($G(^DD(F,0)),U,1)
. S F=UP
. Q
;I NM="" <DO ERROR>
Q NM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIEFU 4017 printed Apr 09, 2024@21:50:36 Page 2
DIEFU ;SF/DPC-FILER UTILITIES ;29OCT2015
+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 ;
INIZE ;
+1 NEW %,X,%H,DIE,DICS,DIC,%DT,DIK,%Y,%X,%D,%M,%I
+2 DO DTNOLF^DICRW
+3 DO CLEAN
+4 QUIT
CLEAN ;
+1 KILL DIRUT,DIROUT,DUOUT,DTOUT
+2 ;K ^TMP("DIERR",$J),^TMP("DIMSG",$J),^TMP("DIHELP",$J)
+3 IF $DATA(^TMP("DIERR",$JOB))
KILL ^($JOB)
+4 IF $DATA(^TMP("DIMSG",$JOB))
KILL ^($JOB)
+5 IF $DATA(^TMP("DIHELP",$JOB))
KILL ^($JOB)
+6 KILL DIERR,DIHELP,DIMSG
+7 QUIT
+8 ;
CALLOUT(DIOUTAR) ;
+1 IF '$$VROOT(DIOUTAR)
QUIT
+2 IF $DATA(DIERR)
Begin DoDot:1
+3 SET @DIOUTAR@("DIERR")=DIERR
+4 MERGE @DIOUTAR@("DIERR")=^TMP("DIERR",$JOB)
+5 KILL ^TMP("DIERR",$JOB)
+6 QUIT
End DoDot:1
+7 IF $DATA(DIHELP)
Begin DoDot:1
+8 SET @DIOUTAR@("DIHELP")=DIHELP
+9 MERGE @DIOUTAR@("DIHELP")=^TMP("DIHELP",$JOB)
+10 KILL ^TMP("DIHELP",$JOB)
+11 QUIT
End DoDot:1
+12 IF $DATA(DIMSG)
Begin DoDot:1
+13 SET @DIOUTAR@("DIMSG")=DIMSG
+14 MERGE @DIOUTAR@("DIMSG")=^TMP("DIMSG",$JOB)
+15 KILL ^TMP("DIMSG",$JOB)
+16 QUIT
End DoDot:1
+17 QUIT
+18 ;
IEN(DIEFDA) ;
IENX ;
+1 IF '$DATA(DIEFDA)
QUIT 0
+2 NEW I,DIEFIEN
SET (I,DIEFIEN)=""
SET DIEFDA(0)=$GET(DIEFDA)
+3 FOR
SET I=$ORDER(DIEFDA(I))
if I=""
QUIT
SET DIEFIEN=DIEFIEN_DIEFDA(I)_","
+4 KILL DIEFDA(0)
+5 QUIT DIEFIEN
+6 ;
DA(DAIEN,DATARG) ;
DAX ;
+1 KILL DATARG
NEW I
+2 FOR I=1:1:$LENGTH(DAIEN,",")-1
SET DATARG(I-1)=$PIECE(DAIEN,",",I)
+3 IF $DATA(DATARG(0))
SET DATARG=DATARG(0)
KILL DATARG(0)
+4 QUIT
+5 ;
VROOT(DIEFAR) ;
+1 IF DIEFAR'["("
QUIT 1
+2 IF $EXTRACT(DIEFAR,$LENGTH(DIEFAR))=")"
IF $FIND(DIEFAR,")")>($FIND(DIEFAR,"(")+1)
QUIT 1
+3 DO BLD^DIALOG(202,"array root")
+4 QUIT 0
+5 ;
VFILE(F,FLAG) ;
VFILEX ;
+1 IF $PIECE($GET(^DD(F,.01,0)),U,2)]""
IF $PIECE(^(0),U,2)'["W"
QUIT 1
+2 IF $GET(FLAG)["D"
NEW P
SET P("FILE")=F
DO BLD^DIALOG(401,.P,.P)
+3 QUIT 0
+4 ;
VENTRY(DIEFF,DIEFIEN,DIEFFLG) ;
+1 NEW DIEFROOT,DIEFDA
+2 SET DIEFFLG=$GET(DIEFFLG)
SET DIEFDA=$PIECE(DIEFIEN,",")
+3 SET DIEFROOT=$$ROOT^DIQGU(DIEFF,DIEFIEN,1,$SELECT(DIEFFLG["D":1,1:0))
if DIEFROOT=""
QUIT 0
+4 IF $PIECE($GET(@DIEFROOT@(DIEFDA,0)),"^",1)=""
Begin DoDot:1
+5 IF DIEFFLG["D"
NEW DIEFP
SET DIEFP("FILE")=DIEFF
SET DIEFP("IENS")=DIEFIEN
DO BLD^DIALOG(601,"",.DIEFP)
End DoDot:1
QUIT 0
+6 IF DIEFFLG["9"
if '$$VMINUS9(DIEFF,DIEFIEN,DIEFFLG)
QUIT 0
+7 QUIT 1
+8 ;
VMINUS9(DIEFF,DIEFIEN,DIEFFLG) ;
+1 NEW DIEFTOP,DIEFROOT
SET DIEFFLG=$GET(DIEFFLG)
+2 SET DIEFTOP=$PIECE(DIEFIEN,",",$LENGTH(DIEFIEN,",")-1)
SET DIEFROOT=$$ROOT^DIQGU($$FNO^DILIBF(DIEFF),.DIEFTOP,1,$SELECT(DIEFFLG["D":1,1:0))
+3 if DIEFROOT=""
QUIT 0
+4 IF $DATA(@DIEFROOT@(DIEFTOP,-9))
Begin DoDot:1
+5 IF DIEFFLG["D"
NEW DIEFP
SET DIEFP("FILE")=DIEFF
SET DIEFP("IENS")=DIEFIEN
DO BLD^DIALOG(602,"",.DIEFP)
End DoDot:1
QUIT 0
+6 QUIT 1
+7 ;
CHKFLD(DIEFF,DIEFFLD) ;
+1 IF DIEFFLD'=+DIEFFLD
SET DIEFFLD=$$FLDNUM^DIEF1(DIEFF,DIEFFLD)
if 'DIEFFLD
QUIT 0
+2 IF '$$VFIELD(DIEFF,DIEFFLD,"D")
QUIT 0
+3 QUIT DIEFFLD
+4 ;
VFIELD(F,FLD,FLAG) ;
VFIELDX ;
+1 IF $DATA(^DD(F,FLD))
QUIT 1
+2 IF $GET(FLAG)["D"
NEW P
SET (P(1),P("FIELD"))=FLD
SET P("FILE")=F
DO BLD^DIALOG(501,.P,.P)
+3 QUIT 0
+4 ;
DT(DIEFDT,DIEFX,DIEFY,DIEFDT0,DIOUTAR) ;
DTX ;
+1 IF '$DATA(DIQUIET)
NEW DIQUIET
SET DIQUIET=1
+2 IF '$DATA(DIFM)
NEW DIFM
SET DIFM=1
DO INIZE
+3 NEW %DT,X,Y
+4 SET DIEFDT=$GET(DIEFDT)
+5 IF $GET(DIEFX)=""
DO BLD^DIALOG(202,"date being converted")
GOTO DTOUT
+6 IF '$$VERFLG^DIEFU(DIEFDT,"FMNPRSTXEeI")
GOTO DTOUT
+7 IF DIEFX?."?"
DO DT^DIEH1(DIEFDT)
SET DIEFY=-1
GOTO DTOUT
+8 SET %DT=DIEFDT
SET X=DIEFX
if $GET(DIEFDT0)]""
SET %DT(0)=DIEFDT0
DO ^%DT
SET DIEFY=Y
+9 IF DIEFY=-1
if DIEFDT'["e"
Begin DoDot:1
+10 NEW DIEFP
+11 SET DIEFP(1)=DIEFX
SET DIEFP(2)="date/time"
+12 DO BLD^DIALOG(330,.DIEFP,.DIEFP)
End DoDot:1
GOTO DTOUT
+13 IF DIEFDT["E"
DO DD^%DT
SET DIEFY(0)=Y
DTOUT IF $GET(DIOUTAR)]""
DO CALLOUT^DIEFU(DIOUTAR)
+1 QUIT
+2 ;
VERFLG(FLG,GDFLGS) ;
+1 NEW EI
+2 SET EI=$TRANSLATE(FLG,GDFLGS,"")
+3 IF EI=""
QUIT 1
+4 DO BLD^DIALOG(301,EI,EI)
+5 QUIT 0
+6 ;
XA(DIEFF,DIEFIEN,DIEFFLD,DIEFNVAL,DIEFOVAL) ;
+1 NEW DA,DIEFCNOD,DOREPL
+2 SET DIEFNVAL=$GET(DIEFNVAL)
SET DIEFOVAL=$GET(DIEFOVAL)
+3 if DIEFNVAL=DIEFOVAL
QUIT
+4 DO DA(DIEFIEN,.DA)
+5 DO XRFAUD^DIEF
+6 QUIT
+7 ;
FILENM(F) ;
+1 NEW NM
+2 ;**CCO/NI GET FILE NAME
SET NM=$$FILENAME^DIALOGZ($$FNO^DILIBF(F))
+3 ;I NM="" <DO ERROR>
+4 QUIT NM
+5 ;
FLDNM(F,FLD) ;
+1 NEW NM,UP
+2 ;**CCO/NI GET FIELD LABEL
SET NM=$$LABEL^DIALOGZ(F,FLD)
+3 FOR
SET UP=$GET(^DD(F,0,"UP"))
if 'UP
QUIT
Begin DoDot:1
+4 SET NM=NM_" in "_$PIECE($GET(^DD(F,0)),U,1)
+5 SET F=UP
+6 QUIT
End DoDot:1
+7 ;I NM="" <DO ERROR>
+8 QUIT NM
