- DILF ;SFISC/STAFF-LIBRARY OF FUNCTIONS ;7:08 AM 25 Apr 2006
- ;;22.0;VA FileMan;**147**;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ;
- LOCK(REF) ;
- ; LOCK the REFerence. $T must be checked upon return **147
- I '$D(DILOCKTM) S DILOCKTM=$G(^DD("DILOCKTM"),1) I $D(@REF) ;TO GET NAKED BACK
- LOCK @("+"_REF_":DILOCKTM")
- Q
- ;
- ;
- ;
- CREF(X) G ENCREF^DIQGU
- ;
- OREF(X) G ENOREF^DIQGU
- ;
- FDA(DIEFF,DIEFDAS,DIEFFLD,DIEFFLG,DIEFVAL,DIEFAR,DIEFOUT) ;
- G LOADX^DIEF1
- ;
- CLEAN ;
- G CLEAN^DIEFU
- ;
- IENS(DIEFDA) ;
- G IENX^DIEFU
- ;
- DA(DAIEN,DATARG) ;
- G DAX^DIEFU
- ;
- DT(DIEFDT,DIEFX,DIEFY,DIEFDT0,DIOUTAR) ;
- G DTX^DIEFU
- ;
- VALUES(DILFILE,DILFLD,DILFDA,DILOUT) ;
- I $G(DILFILE)=""!($G(DILFLD)="")!($G(DILFDA)="") S DILOUT=0 Q
- K DILOUT
- N DILCNT,DILIEN
- S DILIEN=""
- D VALLOOP
- S DILOUT=DILCNT
- Q
- ;
- VALLOOP ;
- S DILCNT=0
- F S DILIEN=$O(@DILFDA@(DILFILE,DILIEN)) Q:DILIEN="" D
- . I $D(@DILFDA@(DILFILE,DILIEN,DILFLD)) D
- . . S DILCNT=DILCNT+1
- . . S DILOUT(DILCNT)=@DILFDA@(DILFILE,DILIEN,DILFLD)
- . . S DILOUT(DILCNT,"IENS")=DILIEN
- Q
- ;
- VALUE1(DILFILE,DILFLD,DILFDA) ;
- I $G(DILFILE)=""!($G(DILFLD)="")!($G(DILFDA)="") Q "^"
- N DILIEN
- S DILIEN=$O(@DILFDA@(DILFILE,""))
- I DILIEN="" Q "^"
- I $D(@DILFDA@(DILFILE,DILIEN,DILFLD)) Q @DILFDA@(DILFILE,DILIEN,DILFLD)
- N DILCNT,DILOUT
- D VALLOOP
- I DILCNT Q DILOUT(1)
- Q "^"
- ;
- ROUSIZE() ;
- Q $G(^DD("ROU"))
- ;
- HTML(DISTRING,DIRECTN) ;
- ;
- ; entry point: use HTML to encode or decode ^ and & characters ; TOAD
- ; extrinsic function: return encoded or decoded value
- ;
- H1 N DILONG,DIRULE I $G(DIRECTN,1)=1 D Q:$G(DILONG) ""
- . S DIRULE(1,"&")="&",DIRULE(2,"^")="^"
- . N DIL S DIL=$L(DISTRING,"^")+$L(DISTRING,"&")-2
- . I $L(DISTRING)-DIL+(DIL*5)>255 D ERR^DICU1(207,,,,DISTRING) S DILONG=1 Q
- E S DIRULE(1,"^")="^",DIRULE(2,"&")="&"
- Q $$TRANSL8(DISTRING,.DIRULE)
- ;
- TRANSL8(DISTRING,DIRULES) ;
- ;
- ; HTML: $TRANSLATE for substrings instead of characters ; TOAD
- ; extrinsic function: return translated value
- ;
- T1 N DIFRENCE,DIFROM,DILENGTH,DITO
- N DI S DI="" F S DI=$O(DIRULES(DI)) Q:DI="" D
- . S DIFROM=$O(DIRULES(DI,"")) Q:DISTRING'[DIFROM
- . S DITO=DIRULES(DI,DIFROM)
- . S DILENGTH=$L(DIFROM)
- . S DIFRENCE=$L(DITO)-DILENGTH
- . S DIAT=0 F D Q:'DIAT
- . . S DIAT=$F(DISTRING,DIFROM,DIAT) Q:'DIAT
- . . S $E(DISTRING,DIAT-DILENGTH,DIAT-1)=DITO
- . . S DIAT=DIAT+DIFRENCE
- Q DISTRING
- DILF ;SFISC/STAFF-LIBRARY OF FUNCTIONS ;7:08 AM 25 Apr 2006
- +1 ;;22.0;VA FileMan;**147**;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;
- LOCK(REF) ;
- +1 ; LOCK the REFerence. $T must be checked upon return **147
- +2 ;TO GET NAKED BACK
- IF '$DATA(DILOCKTM)
- SET DILOCKTM=$GET(^DD("DILOCKTM"),1)
- IF $DATA(@REF)
- +3 LOCK @("+"_REF_":DILOCKTM")
- +4 QUIT
- +5 ;
- +6 ;
- +7 ;
- CREF(X) GOTO ENCREF^DIQGU
- +1 ;
- OREF(X) GOTO ENOREF^DIQGU
- +1 ;
- FDA(DIEFF,DIEFDAS,DIEFFLD,DIEFFLG,DIEFVAL,DIEFAR,DIEFOUT) ;
- +1 GOTO LOADX^DIEF1
- +2 ;
- CLEAN ;
- +1 GOTO CLEAN^DIEFU
- +2 ;
- IENS(DIEFDA) ;
- +1 GOTO IENX^DIEFU
- +2 ;
- DA(DAIEN,DATARG) ;
- +1 GOTO DAX^DIEFU
- +2 ;
- DT(DIEFDT,DIEFX,DIEFY,DIEFDT0,DIOUTAR) ;
- +1 GOTO DTX^DIEFU
- +2 ;
- VALUES(DILFILE,DILFLD,DILFDA,DILOUT) ;
- +1 IF $GET(DILFILE)=""!($GET(DILFLD)="")!($GET(DILFDA)="")
- SET DILOUT=0
- QUIT
- +2 KILL DILOUT
- +3 NEW DILCNT,DILIEN
- +4 SET DILIEN=""
- +5 DO VALLOOP
- +6 SET DILOUT=DILCNT
- +7 QUIT
- +8 ;
- VALLOOP ;
- +1 SET DILCNT=0
- +2 FOR
- SET DILIEN=$ORDER(@DILFDA@(DILFILE,DILIEN))
- IF DILIEN=""
- QUIT
- Begin DoDot:1
- +3 IF $DATA(@DILFDA@(DILFILE,DILIEN,DILFLD))
- Begin DoDot:2
- +4 SET DILCNT=DILCNT+1
- +5 SET DILOUT(DILCNT)=@DILFDA@(DILFILE,DILIEN,DILFLD)
- +6 SET DILOUT(DILCNT,"IENS")=DILIEN
- End DoDot:2
- End DoDot:1
- +7 QUIT
- +8 ;
- VALUE1(DILFILE,DILFLD,DILFDA) ;
- +1 IF $GET(DILFILE)=""!($GET(DILFLD)="")!($GET(DILFDA)="")
- QUIT "^"
- +2 NEW DILIEN
- +3 SET DILIEN=$ORDER(@DILFDA@(DILFILE,""))
- +4 IF DILIEN=""
- QUIT "^"
- +5 IF $DATA(@DILFDA@(DILFILE,DILIEN,DILFLD))
- QUIT @DILFDA@(DILFILE,DILIEN,DILFLD)
- +6 NEW DILCNT,DILOUT
- +7 DO VALLOOP
- +8 IF DILCNT
- QUIT DILOUT(1)
- +9 QUIT "^"
- +10 ;
- ROUSIZE() ;
- +1 QUIT $GET(^DD("ROU"))
- +2 ;
- HTML(DISTRING,DIRECTN) ;
- +1 ;
- +2 ; entry point: use HTML to encode or decode ^ and & characters ; TOAD
- +3 ; extrinsic function: return encoded or decoded value
- +4 ;
- H1 NEW DILONG,DIRULE
- IF $GET(DIRECTN,1)=1
- Begin DoDot:1
- +1 SET DIRULE(1,"&")="&"
- SET DIRULE(2,"^")="^"
- +2 NEW DIL
- SET DIL=$LENGTH(DISTRING,"^")+$LENGTH(DISTRING,"&")-2
- +3 IF $LENGTH(DISTRING)-DIL+(DIL*5)>255
- DO ERR^DICU1(207,,,,DISTRING)
- SET DILONG=1
- QUIT
- End DoDot:1
- IF $GET(DILONG)
- QUIT ""
- +4 IF '$TEST
- SET DIRULE(1,"^")="^"
- SET DIRULE(2,"&")="&"
- +5 QUIT $$TRANSL8(DISTRING,.DIRULE)
- +6 ;
- TRANSL8(DISTRING,DIRULES) ;
- +1 ;
- +2 ; HTML: $TRANSLATE for substrings instead of characters ; TOAD
- +3 ; extrinsic function: return translated value
- +4 ;
- T1 NEW DIFRENCE,DIFROM,DILENGTH,DITO
- +1 NEW DI
- SET DI=""
- FOR
- SET DI=$ORDER(DIRULES(DI))
- IF DI=""
- QUIT
- Begin DoDot:1
- +2 SET DIFROM=$ORDER(DIRULES(DI,""))
- IF DISTRING'[DIFROM
- QUIT
- +3 SET DITO=DIRULES(DI,DIFROM)
- +4 SET DILENGTH=$LENGTH(DIFROM)
- +5 SET DIFRENCE=$LENGTH(DITO)-DILENGTH
- +6 SET DIAT=0
- FOR
- Begin DoDot:2
- +7 SET DIAT=$FIND(DISTRING,DIFROM,DIAT)
- IF 'DIAT
- QUIT
- +8 SET $EXTRACT(DISTRING,DIAT-DILENGTH,DIAT-1)=DITO
- +9 SET DIAT=DIAT+DIFRENCE
- End DoDot:2
- IF 'DIAT
- QUIT
- End DoDot:1
- +10 QUIT DISTRING
