- DIEFU ;SF/DPC-FILER UTILITIES ;1:56 PM 25 May 2001 [ 04/02/2003 8:25 AM ]
- ;;22.0;VA FileMan;**1001,1019**;APR 1, 2003;Build 2
- ;;22.0;VA FileMan;**85**;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;IHS/OIT/FBD - DI*22.0*1019 - 11/13/2015 - ATTEMPT TO REDUCE DISK BLOCK
- ; COLLISIONS BY REPLACING CLEAN SURBROUTINE'S UNCONDITIONAL KILLS
- ; WITH CONDITIONAL PRE-CHECKS
- ;
- 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) ;DI*22.0*1019 - IHS/OIT/FBD - ORIGINAL LINE - COMMENTED OUT
- I $D(^TMP("DIERR",$J)) K ^TMP("DIERR",$J) ;DI*22.0*1019 - IHS/OIT/FBD - ADDED LINE
- I $D(^TMP("DIMSG",$J)) K ^TMP("DIMSG",$J) ;DI*22.0*1019 - IHS/OIT/FBD - ADDED LINE
- I $D(^TMP("DIHELP",$J)) K ^TMP("DIHELP",$J) ;DI*22.0*1019 - IHS/OIT/FBD - ADDED LINE
- 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=$P($G(^DIC($$FNO^DILIBF(F),0)),U)
- ;I NM="" <DO ERROR>
- Q NM
- ;
- FLDNM(F,FLD) ;
- N NM,UP
- S NM=$P($G(^DD(F,FLD,0)),U,1)
- 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
- DIEFU ;SF/DPC-FILER UTILITIES ;1:56 PM 25 May 2001 [ 04/02/2003 8:25 AM ]
- +1 ;;22.0;VA FileMan;**1001,1019**;APR 1, 2003;Build 2
- +2 ;;22.0;VA FileMan;**85**;Mar 30, 1999
- +3 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +4 ;IHS/OIT/FBD - DI*22.0*1019 - 11/13/2015 - ATTEMPT TO REDUCE DISK BLOCK
- +5 ; COLLISIONS BY REPLACING CLEAN SURBROUTINE'S UNCONDITIONAL KILLS
- +6 ; WITH CONDITIONAL PRE-CHECKS
- +7 ;
- 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) ;DI*22.0*1019 - IHS/OIT/FBD - ORIGINAL LINE - COMMENTED OUT
- +3 ;DI*22.0*1019 - IHS/OIT/FBD - ADDED LINE
- IF $DATA(^TMP("DIERR",$JOB))
- KILL ^TMP("DIERR",$JOB)
- +4 ;DI*22.0*1019 - IHS/OIT/FBD - ADDED LINE
- IF $DATA(^TMP("DIMSG",$JOB))
- KILL ^TMP("DIMSG",$JOB)
- +5 ;DI*22.0*1019 - IHS/OIT/FBD - ADDED LINE
- IF $DATA(^TMP("DIHELP",$JOB))
- KILL ^TMP("DIHELP",$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 SET NM=$PIECE($GET(^DIC($$FNO^DILIBF(F),0)),U)
- +3 ;I NM="" <DO ERROR>
- +4 QUIT NM
- +5 ;
- FLDNM(F,FLD) ;
- +1 NEW NM,UP
- +2 SET NM=$PIECE($GET(^DD(F,FLD,0)),U,1)
- +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
