| 1 | DICU ;SEA/TOAD-VA FileMan: Lookup Utilities ;5/15/97 08:31
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;11961;3150917;2853;
|
|---|
| 5 | ;
|
|---|
| 6 | REQIDS(DIFILE,DITARGET) ;
|
|---|
| 7 | ; return REQUIRED IDENTIFIERS file attribute
|
|---|
| 8 | ; DIFILE = file#, DITARGET = target array
|
|---|
| 9 | N DIATTRBT S DIATTRBT="REQUIRED IDENTIFIERS"
|
|---|
| 10 | S @DITARGET@(DIATTRBT,.01)=""
|
|---|
| 11 | N DIFIELD
|
|---|
| 12 | S DIFIELD=0 F S DIFIELD=$O(^DD(DIFILE,0,"ID",DIFIELD)) Q:'DIFIELD D
|
|---|
| 13 | . I $D(^DD(DIFILE,"RQ",DIFIELD)) S @DITARGET@(DIATTRBT,DIFIELD)=""
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | RID(DIFILE) ;
|
|---|
| 17 | ; return a string listing a file's required identifiers
|
|---|
| 18 | ; DIFILE = file#
|
|---|
| 19 | N DILIST S DILIST=".01"
|
|---|
| 20 | N DID S DID="" F S DID=$O(^DD(DIFILE,0,"ID",DID)) Q:'DID D
|
|---|
| 21 | . I $D(^DD(DIFILE,"RQ",DID)) S DILIST=DILIST_U_DID
|
|---|
| 22 | Q DILIST
|
|---|
| 23 | ;
|
|---|
| 24 | RECALL(DIFILE,DIEN,DIUSER) ;
|
|---|
| 25 | RECALLX ; input from DILFD
|
|---|
| 26 | ;
|
|---|
| 27 | ; ENTRY POINT--save a user's selection for use with space-bar recall
|
|---|
| 28 | ; procedure, all passed by value
|
|---|
| 29 | ;
|
|---|
| 30 | I '$D(DIQUIET) N DIQUIET S DIQUIET=1
|
|---|
| 31 | I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
|
|---|
| 32 | N DICLERR S DICLERR=$G(DIERR) K DIERR
|
|---|
| 33 | ;
|
|---|
| 34 | 30 S DIFILE=$G(DIFILE)
|
|---|
| 35 | I +DIFILE'=DIFILE!(DIFILE<0) D ERR(202,"","","","file") Q
|
|---|
| 36 | S DIEN=$G(DIEN) I DIEN="" S DIEN=","
|
|---|
| 37 | I '$$IEN^DIDU1(DIEN) D ERR(202,"","","","IEN string") Q
|
|---|
| 38 | S DIUSER=+$G(DIUSER)
|
|---|
| 39 | ;
|
|---|
| 40 | 32 N DIOROOT,DIOUT S DIOUT=0 D I DIOUT Q
|
|---|
| 41 | . I '$D(^DD(DIFILE)) D ERR(401,DIFILE) S DIOUT=1 Q
|
|---|
| 42 | . S DIOROOT=$$ROOT^DILFD(DIFILE,DIEN,"Q")
|
|---|
| 43 | . I DIOROOT'?1"^"1U.7UN1"(".ANP,DIOROOT'?1"^%".7UN1"(".ANP D Q
|
|---|
| 44 | . . D ERR(402,DIFILE,"","","","","",DIOROOT) S DIOUT=1
|
|---|
| 45 | S ^DISV(DIUSER,$E(DIOROOT,1,28))=$E(DIOROOT,29,$L(DIOROOT))_+DIEN
|
|---|
| 46 | I DICLERR'=""!$G(DIERR) D
|
|---|
| 47 | . S DIERR=$G(DIERR)+DICLERR_U_($P($G(DIERR),U,2)+$P(DICLERR,U,2))
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | FILE(DIFILE,DIDA,DIFLAGS,DIROOT) ;
|
|---|
| 51 | ; entry point -- given a root, calculate the file # and DA
|
|---|
| 52 | ; DO NOT USE UNTIL $QS & $QL AVAILABLE
|
|---|
| 53 | N DIGLOBAL I $G(DIFLAGS)'["O" S DIGLOBAL=DIROOT
|
|---|
| 54 | E S DIGLOBAL=$$CREF^DIQGU(DIROOT),DIROOT=DIGLOBAL
|
|---|
| 55 | S DIFILE=+$P($G(@DIGLOBAL@(0)),U,2),DIDA=""
|
|---|
| 56 | N DA,DIENTRY S DA=1,DIENTRY=0
|
|---|
| 57 | ;
|
|---|
| 58 | LOOP N DICHAR,DIL,DILEAD,DIQL,DIQS,DIQSL F D Q:'DIQL
|
|---|
| 59 | .
|
|---|
| 60 | STRIP .
|
|---|
| 61 | . ; S DIQL=$QL(DIGLOBAL) Q:'DIQL
|
|---|
| 62 | . ; S DIQS=$QS(DIGLOBAL,DIQL)
|
|---|
| 63 | . N DIQSL S DIQSL=$L(DIQS)+1 I +DIQS'=DIQS S DIQSL=DIQSL+2
|
|---|
| 64 | . S DIL=$L(DIGLOBAL),DILEAD=DIL-DIQSL
|
|---|
| 65 | . S $E(DIGLOBAL,DILEAD+1,DIL-1)=""
|
|---|
| 66 | . S DICHAR=$E(DIGLOBAL,DILEAD)
|
|---|
| 67 | . I DICHAR="," S $E(DIGLOBAL,DILEAD)=""
|
|---|
| 68 | . E I DICHAR="(" S $E(DIGLOBAL,DILEAD,DILEAD+1)=""
|
|---|
| 69 | . E S DIGLOBAL="ERROR: "_DIGLOBAL,DIQL=0
|
|---|
| 70 | .
|
|---|
| 71 | ENTRY . I DIENTRY D
|
|---|
| 72 | . . S DIFILE(DA)=+$P($G(@DIGLOBAL@(0)),U,2)
|
|---|
| 73 | . . S DIROOT(DA)=DIGLOBAL
|
|---|
| 74 | . . S DIDA(DA)=DIQS,DA=DA+1
|
|---|
| 75 | . S DIENTRY='DIENTRY
|
|---|
| 76 | Q
|
|---|
| 77 | ;
|
|---|
| 78 | ERR(DIERN,DIFILE,DIIENS,DIFIELD,DI1,DI2,DI3,DIROOT) ;
|
|---|
| 79 | ;
|
|---|
| 80 | ; error logging procedure
|
|---|
| 81 | ; RECALL
|
|---|
| 82 | ;
|
|---|
| 83 | N DIPE,DI
|
|---|
| 84 | F DI="FILE","IENS","FIELD",1:1:3,"ROOT" S DIPE(DI)=$G(@("DI"_DI))
|
|---|
| 85 | D BLD^DIALOG(DIERN,.DIPE,.DIPE)
|
|---|
| 86 | S DIERR=$G(DIERR)+DICLERR_U_($P($G(DIERR),U,2)+$P(DICLERR,U,2))
|
|---|
| 87 | Q
|
|---|
