| 1 | DILF ;SFISC/STAFF-LIBRARY OF FUNCTIONS ;7:08 AM 25 Apr 2006
|
|---|
| 2 | ;;22.0;VA FileMan;**147**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | LOCK(REF) ;
|
|---|
| 8 | ; LOCK the REFerence. $T must be checked upon return **147
|
|---|
| 9 | I '$D(DILOCKTM) S DILOCKTM=$G(^DD("DILOCKTM"),1) I $D(@REF) ;TO GET NAKED BACK
|
|---|
| 10 | LOCK @("+"_REF_":DILOCKTM")
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | ;
|
|---|
| 14 | ;
|
|---|
| 15 | CREF(X) G ENCREF^DIQGU
|
|---|
| 16 | ;
|
|---|
| 17 | OREF(X) G ENOREF^DIQGU
|
|---|
| 18 | ;
|
|---|
| 19 | FDA(DIEFF,DIEFDAS,DIEFFLD,DIEFFLG,DIEFVAL,DIEFAR,DIEFOUT) ;
|
|---|
| 20 | G LOADX^DIEF1
|
|---|
| 21 | ;
|
|---|
| 22 | CLEAN ;
|
|---|
| 23 | G CLEAN^DIEFU
|
|---|
| 24 | ;
|
|---|
| 25 | IENS(DIEFDA) ;
|
|---|
| 26 | G IENX^DIEFU
|
|---|
| 27 | ;
|
|---|
| 28 | DA(DAIEN,DATARG) ;
|
|---|
| 29 | G DAX^DIEFU
|
|---|
| 30 | ;
|
|---|
| 31 | DT(DIEFDT,DIEFX,DIEFY,DIEFDT0,DIOUTAR) ;
|
|---|
| 32 | G DTX^DIEFU
|
|---|
| 33 | ;
|
|---|
| 34 | VALUES(DILFILE,DILFLD,DILFDA,DILOUT) ;
|
|---|
| 35 | I $G(DILFILE)=""!($G(DILFLD)="")!($G(DILFDA)="") S DILOUT=0 Q
|
|---|
| 36 | K DILOUT
|
|---|
| 37 | N DILCNT,DILIEN
|
|---|
| 38 | S DILIEN=""
|
|---|
| 39 | D VALLOOP
|
|---|
| 40 | S DILOUT=DILCNT
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | VALLOOP ;
|
|---|
| 44 | S DILCNT=0
|
|---|
| 45 | F S DILIEN=$O(@DILFDA@(DILFILE,DILIEN)) Q:DILIEN="" D
|
|---|
| 46 | . I $D(@DILFDA@(DILFILE,DILIEN,DILFLD)) D
|
|---|
| 47 | . . S DILCNT=DILCNT+1
|
|---|
| 48 | . . S DILOUT(DILCNT)=@DILFDA@(DILFILE,DILIEN,DILFLD)
|
|---|
| 49 | . . S DILOUT(DILCNT,"IENS")=DILIEN
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | VALUE1(DILFILE,DILFLD,DILFDA) ;
|
|---|
| 53 | I $G(DILFILE)=""!($G(DILFLD)="")!($G(DILFDA)="") Q "^"
|
|---|
| 54 | N DILIEN
|
|---|
| 55 | S DILIEN=$O(@DILFDA@(DILFILE,""))
|
|---|
| 56 | I DILIEN="" Q "^"
|
|---|
| 57 | I $D(@DILFDA@(DILFILE,DILIEN,DILFLD)) Q @DILFDA@(DILFILE,DILIEN,DILFLD)
|
|---|
| 58 | N DILCNT,DILOUT
|
|---|
| 59 | D VALLOOP
|
|---|
| 60 | I DILCNT Q DILOUT(1)
|
|---|
| 61 | Q "^"
|
|---|
| 62 | ;
|
|---|
| 63 | ROUSIZE() ;
|
|---|
| 64 | Q $G(^DD("ROU"))
|
|---|
| 65 | ;
|
|---|
| 66 | HTML(DISTRING,DIRECTN) ;
|
|---|
| 67 | ;
|
|---|
| 68 | ; entry point: use HTML to encode or decode ^ and & characters ; TOAD
|
|---|
| 69 | ; extrinsic function: return encoded or decoded value
|
|---|
| 70 | ;
|
|---|
| 71 | H1 N DILONG,DIRULE I $G(DIRECTN,1)=1 D Q:$G(DILONG) ""
|
|---|
| 72 | . S DIRULE(1,"&")="&",DIRULE(2,"^")="^"
|
|---|
| 73 | . N DIL S DIL=$L(DISTRING,"^")+$L(DISTRING,"&")-2
|
|---|
| 74 | . I $L(DISTRING)-DIL+(DIL*5)>255 D ERR^DICU1(207,,,,DISTRING) S DILONG=1 Q
|
|---|
| 75 | E S DIRULE(1,"^")="^",DIRULE(2,"&")="&"
|
|---|
| 76 | Q $$TRANSL8(DISTRING,.DIRULE)
|
|---|
| 77 | ;
|
|---|
| 78 | TRANSL8(DISTRING,DIRULES) ;
|
|---|
| 79 | ;
|
|---|
| 80 | ; HTML: $TRANSLATE for substrings instead of characters ; TOAD
|
|---|
| 81 | ; extrinsic function: return translated value
|
|---|
| 82 | ;
|
|---|
| 83 | T1 N DIFRENCE,DIFROM,DILENGTH,DITO
|
|---|
| 84 | N DI S DI="" F S DI=$O(DIRULES(DI)) Q:DI="" D
|
|---|
| 85 | . S DIFROM=$O(DIRULES(DI,"")) Q:DISTRING'[DIFROM
|
|---|
| 86 | . S DITO=DIRULES(DI,DIFROM)
|
|---|
| 87 | . S DILENGTH=$L(DIFROM)
|
|---|
| 88 | . S DIFRENCE=$L(DITO)-DILENGTH
|
|---|
| 89 | . S DIAT=0 F D Q:'DIAT
|
|---|
| 90 | . . S DIAT=$F(DISTRING,DIFROM,DIAT) Q:'DIAT
|
|---|
| 91 | . . S $E(DISTRING,DIAT-DILENGTH,DIAT-1)=DITO
|
|---|
| 92 | . . S DIAT=DIAT+DIFRENCE
|
|---|
| 93 | Q DISTRING
|
|---|
