Annotation of freem_fileman/DICF.m, revision 1.1
1.1 ! snw 1: DICF ;SEA/TOAD-VA FileMan: Finder, Part 1 (Main) ;11/17/94 11:23 ;
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 3: ;Per VHA Directive 10-93-142, this routine should not be modified.
! 4:
! 5: FIND(DIFILE,DIEN,DIFLDS,DIFLAGS,DIVALUE,DIMAX,DIFORCE,DISCREEN,DID,DILIST,DIMSGA)
! 6: ; ENTRY POINT--silent selecter
! 7: ; subroutine, DIFORCE passed by reference
! 8:
! 9: FINDX ; branch in from FIND^DIC
! 10: I '$D(DIQUIET) N DIQUIET S DIQUIET=1
! 11: I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
! 12: N DA,DICOUNT,DIFAIL,DIROOT
! 13: I $G(DIFLAGS)'["p"!($G(DIFLAGS)["l") N DILVA
! 14: S (DICOUNT,DICOUNT(0))=+$G(DILIST("C"))
! 15: S DICOUNT("LOOK")=0
! 16: S DICOUNT("MORE")=0
! 17: S DICOUNT("MAX")=$G(DIMAX) I DICOUNT("MAX")="" S DICOUNT("MAX")="*"
! 18: S DILIST(0)=$G(DILIST(0)) I DILIST(0)<1 S DILIST(0)=1
! 19:
! 20: INPUT
! 21: S DIFAIL=0 D I DIFAIL D CLOSE Q
! 22: I0 . ; flags
! 23: . S DIFLAGS=$G(DIFLAGS)
! 24: . I DIFLAGS["O",DIFLAGS["X" S DIFLAGS=$TR(DIFLAGS,"O")
! 25: . I DIFLAGS'["p" S DIFLAGS=DIFLAGS_"t"
! 26: . I DIFLAGS["p" S DIFLAGS=DIFLAGS_"f"
! 27: I1 . ; value
! 28: . S DIVALUE=$G(DIVALUE)
! 29: I2 . ; target_root
! 30: . I $G(DIMSGA)'="" D
! 31: . . K @DIMSGA@("DIMSG"),@DIMSGA@("DIERR"),@DIMSGA@("DIHELP")
! 32: . S DILIST=$G(DILIST)
! 33: . I DILIST'="" I DIFLAGS'["v" K @DILIST
! 34: . I DILIST'="",DIFLAGS'["f" S DILIST=$NA(@DILIST@("DILIST"))
! 35: . I DILIST="" S DILIST="^TMP(""DILIST"",$J)" I DIFLAGS'["v" K @DILIST
! 36: . S DILIST("LVA")=$G(DILIST("LVA"))
! 37: . I DILIST("LVA")="" S DILIST("LVA")="DILVA"
! 38: . I DIFLAGS["p",DIVALUE'="",$G(@DILIST("LVA")@("V"))="" D
! 39: . . S DIFLAGS=DIFLAGS_"t"
! 40: I3 . ; file
! 41: . S DIFILE=$G(DIFILE) I 'DIFILE S DIFAIL=1 D Q
! 42: . . D ERR^DICF6(202,"","","","FILE")
! 43: . N DINODE S DINODE=$G(^DD(DIFILE,.01,0))
! 44: . I DINODE="" S DIFAIL=1 D Q
! 45: . . D ERR^DICF6($S('$D(^DD(DIFILE)):401,1:406),DIFILE)
! 46: . I $P(DINODE,U,2)["W" S DIFAIL=1 D ERR^DICF6(407,DIFILE) Q
! 47: . S DISCREEN("F")=$G(^DD(DIFILE,0,"SCR"))
! 48: I4 . ; IENS
! 49: . S DIEN=$G(DIEN) I DIEN="" S DIEN=","
! 50: . I '$$IEN^DIDU1(DIEN) S DIFAIL=1 D Q
! 51: . . I '$$IEN^DIDU1(DIEN_",") D ERR^DICF6(202,"","","","IENS") Q
! 52: . . E D ERR^DICF6(304,"",DIEN) Q
! 53: . I $P(DIEN,",")'="" S DIFAIL=1 D ERR^DICF6(306,"",DIEN) Q
! 54: . I DIEN["," D DA^DILF(DIEN,.DA) S DA=DIEN M DIEN=DA
! 55: I5 . ; file root
! 56: . S DIROOT=$$ROOT^DIQGU(DIFILE,DIEN,1,1) I $G(DIERR) S DIFAIL=1 Q
! 57: . I DIROOT="" S DIFAIL=1 D Q
! 58: . . D ERR^DICF6(402,DIFILE,DIEN)
! 59: . I $O(@DIROOT@(0))'>0 S DIFAIL=1 Q
! 60: . S DIROOT("O")=$$OREF^DIQGU(DIROOT)
! 61: . I DIFLAGS["v" S DIROOT("V")=DIROOT("O"),$E(DIROOT("V"))=";"
! 62: . I DIVALUE=" " S DIROOT("Q")=$$ROOT^DIQGU(DIFILE,DIEN,"Q")
! 63: I6 . ; fields
! 64: . S DIFLDS=$G(DIFLDS)
! 65: I7 . ; flags again
! 66: . I $TR(DIFLAGS,"AMOQXfglpqtuv")'="" S DIFAIL=1 D Q
! 67: . . D ERR^DICF6(301,"","","",$TR(DIFLAGS,"fglpqtuv"))
! 68: . I $O(@DIROOT@("A["))="" S DIFLAGS=DIFLAGS_"u"
! 69: I8 . ; forced indexes
! 70: . S DIFORCE=$G(DIFORCE)
! 71: . I "*"[DIFORCE S DIFORCE=0,DIFORCE(0)="*"
! 72: . E I DIFORCE="#" S DIFORCE=0,DIFORCE(0)="#",DIFLAGS=DIFLAGS_"u"
! 73: . E D I DIFAIL D ERR^DICF6(202,"","","","Indexes") Q
! 74: . . S DIFORCE(0)=$G(DIFORCE)
! 75: . . I $P(DIFORCE(0),U)="" S DIFAIL=1 Q
! 76: . . S DIFLAGS=DIFLAGS_"M"
! 77: . . S DIFORCE=1
! 78: I9 . ; rest
! 79: . I DICOUNT("MAX")'="*" D Q:DIFAIL
! 80: . . I DICOUNT("MAX")\1=DICOUNT("MAX"),DICOUNT("MAX")>0 Q
! 81: . . S DIFAIL=1 D ERR^DICF6(202,"","","","Number")
! 82: . S DISCREEN=$G(DISCREEN)
! 83: . S DID=$G(DID)
! 84:
! 85: HOOK75
! 86: N DIHOOK75,DIOUT
! 87: S DIHOOK75=$G(^DD(DIFILE,.01,7.5))
! 88: S DIOUT=0
! 89: I DIHOOK75'="",U'[DIVALUE,DIVALUE'?."?" D I DIOUT D CLOSE Q
! 90: . N %,D,DIC,X,Y,Y1
! 91: . S D=DIFORCE(0)
! 92: . S DIC=DIFILE
! 93: . S DIC(0)=$TR(DIFLAGS,"fglpqtuv")
! 94: . S X=DIVALUE
! 95: . M Y=DIEN S Y=""
! 96: . S Y1=DIEN
! 97: . X DIHOOK75 I '$D(X)!$G(DIERR) S DIOUT=1 D:$G(DIERR) Q
! 98: . . D ERR^DICF6(120,DIFILE,"",.01,"Pre-lookup Transform (7.5 node)")
! 99: . S DIVALUE=X
! 100: . I $G(DIC("S"))'="" S DISCREEN=DIC("S")
! 101: . I $G(DIC("V"))'="" S DISCREEN("V")=DIC("V")
! 102:
! 103: LOOKUP
! 104: N DIDENT
! 105: I DIFLAGS'["f" D I $G(DIERR) D CLOSE Q
! 106: . D IDENTS^DICU1(DIFILE,.01,.DIROOT,DIFLDS,DID,.DIDENT)
! 107: I DIFLAGS'["p" D SPECIAL^DICF1(DIFILE,.DIEN,DIFLAGS,.DIROOT,DIVALUE,DIFORCE(0),.DICOUNT,.DIFAIL,.DISCREEN,.DIDENT,.DIOUT,.DILIST)
! 108: I DIOUT D CLOSE Q
! 109: I DIFLAGS["t" D
! 110: . D XFORM^DICF1(.DIFLAGS,.DIVALUE,.DISCREEN,.DILVA,.DILIST)
! 111: I DIFLAGS["u" ;D UPRIGHT^DICF4(DIFILE,.DIEN,.DIFLAGS,.DIROOT,.DIVALUE,.DICOUNT,.DISCREEN,.DIDENT,.DILIST) I 1
! 112: E D CHKALL^DICF2(DIFILE,.DIEN,DIFLAGS,.DIROOT,.DIVALUE,.DICOUNT,.DISCREEN,.DIFORCE,.DIDENT,.DILIST)
! 113: D CLOSE
! 114: Q
! 115:
! 116: CLOSE
! 117: ; cleanup
! 118: I $G(DIMSGA)'="" D CALLOUT^DIEFU(DIMSGA)
! 119: I '$G(DIERR),DIFLAGS'["p" S @DILIST@(0)=DICOUNT_U_DICOUNT("MAX")_U_DICOUNT("MORE")
! 120: I DILIST'="" K @DILIST@("B")
! 121: K ^TMP("DILVA",$J,DILIST(0))
! 122: I DILIST(0)=1 K ^TMP("DILVA",$J)
! 123: S DILIST("C")=DICOUNT
! 124: Q
! 125:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DICF.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman