- AUFMLK ;DICTIONARY ENTRY LOOK-UP UTILITY (FILE MANAGER COMPATIBLE) [ 12/23/86 1:53 PM ]
- ;IHS-OKLA CITY AREA OFFICE-LMD
- L1 S:$D(D0) LKD0=D0 S:$D(X) LKX=X S:$D(Y)#2 LKY=Y K LKPCC,LKPRINT,LKDATA,LKERR,LKGL,LKDENT,LKNEW G END:'$D(LKDR)!'$D(LKDIC)!'$D(LKDA) S LK("I")=1,LKDIC(1)=LKDIC,LKDR(1)=LKDR G END:+LKDR<.01!(+LKDIC<1)!(+LKDA<1)
- S:$D(^DD(LKDIC,LKDR,0)) LKG=^DD(LKDIC,LKDR,0) G COMP:$P(LKG,"^",2)["C" I +$P(LKG,"^",2)>0 S LKERR=5 G END
- L2 I '$D(^DD(LKDIC(LK("I")),LKDR(LK("I")),0)) S LKERR=3 G END
- S LKSUB=$P(^DD(LKDIC(LK("I")),LKDR(LK("I")),0),"^",4),LKPC(LK("I"))=$P(LKSUB,";",2),LKSUB(LK("I"))=$P(LKSUB,";",1) I '$D(^DD(LKDIC(LK("I")),0,"UP")) G L4
- L3 S LKERR=4 S:$D(LKDRENT1) LKDRENT=0 G END:'$D(LKDRENT) G END:LKDRENT'="0"&(+LKDRENT<0) G END:LKDRENT\1'=LKDRENT S:LKDRENT=0 LKNEW="" K LKERR
- S LK("I")=LK("I")+1,LKDIC(LK("I"))=^DD(LKDIC(LK("I")-1),0,"UP"),LKDR(LK("I"))=0,LKDR(LK("I"))=$O(^DD(LKDIC(LK("I")),"SB",LKDIC(LK("I")-1),LKDR(LK("I")))) G L2
- L4 S LKGL=^DIC(LKDIC(LK("I")),0,"GL")_LKDA,LKGL(1)=LKGL_",0)" I '$D(@LKGL(1)) S LKERR=1 G END
- I LK("I")=1 K:$D(LKDRENT) LKDRENT G L5
- F LK("J")=LK("I"):-1:2 S LKGL=LKGL_","_LKSUB(LK("J")) S:LK("J")>2 LKGL=LKGL_",1"
- L5 S LKPCC=LKPC(1) I '$D(LKDRENT) S LKDRENT="" G L6
- L5A S LKGL(0)=LKGL_",0)" I '$D(@LKGL(0)) S LKERR=6,LKGL=LKGL_",1,0)" G END
- L5B S LKDENT=$P(@LKGL(0),"^",4) S:LKDENT="" LKDENT=0 I LKDENT=0!(LKDRENT>LKDENT) S LKERR=2 G END
- L5BB I $D(LKDRENT1) D DNT4 G L5E:LKDNT'="" S LKERR=2 G END
- L5C I LKDRENT>0 D DNT2 S LKDRENT=LKDNT G L5E:LKDNTT>0 S LKERR=2 G END
- L5D S LKGL(0)=LKGL_",0)" D DNT
- L5E S LKDRENT=","_LKDRENT
- L6 S LKGL=LKGL_LKDRENT_","_LKSUB(1)_")" I LKGL[",," S LKERR=2,LKNEW="" G END
- I '$D(@LKGL) S LKERR=2,LKNEW="" G END
- L6A S (LKPRINT,LKDATA)=$P(@LKGL,"^",LKPC(1)) G END:LKPRINT=""
- L7 S LKGG=$P(LKG,"^",2),LK("H")=$P(LKG,"^",3) G SET:LKGG["S",DATE:LKGG["D",PTR:LKGG["P",COMP:LKGG["C",TRX:$D(^DD(LKDIC(1),LKDR(1),2))
- END S:$D(LKD0) D0=LKD0 S:$D(LKX) X=LKX S:$D(LKY) Y=LKY K LKDIC,LKNEW,LKD0,LKX,LKY,LKDRENT,LKDRENT1,LKDNT,LKDNTT,LK,LKH,LKGG,LKGGG,LKGLL,LKSUB,LKPC,LKDR,LKDA S:'$D(LKPRINT)&'$D(LKERR) LKERR=0 Q
- DNT S LKDNT=0
- DNT1 S LKGLL=LKGL_",LKDNT)",LKDNT=$O(@LKGLL) Q:LKDNT="" S LKDRENT=LKDNT G DNT1
- DNT2 S (LKDNT,LKDNTT)=0
- DNT3 S LKGLL=LKGL_",LKDNT)",LKDNT=$O(@LKGLL) Q:LKDNT="" S LKDNTT=LKDNTT+1 Q:LKDNTT=LKDRENT G DNT3
- DNT4 S LKDNT=0
- DNT5 S LKGLL=LKGL_",LKDNT)",LKDNT=$O(@LKGLL) Q:LKDNT="" S:LKDNT=LKDRENT1 LKDRENT=LKDNT Q:LKDRENT=LKDNT G DNT5
- SET F LK("I")=1:1 S LKGGG=$P(LK("H"),";",LK("I")) G END:LKGGG="" S:$P(LKGGG,":",1)=LKDATA LKPRINT=$P(LKGGG,":",2)
- G END
- DATE S Y=LKDATA X ^DD("DD") S LKPRINT=Y G END
- PTR S LKGGG="^"_LK("H")_LKDATA_",0)" I '$D(@LKGGG) S LKERR=7 G END
- S LKPRINT=$P(@LKGGG,"^",1) G END
- COMP S LKH=$E($P(LKG,";",2),3,999),D0=LKDA X LKH S LKPRINT=X G END
- TRX S Y=LKDATA X ^DD(LKDIC(1),LKDR(1),2) S LKPRINT=X G END
- AUFMLK ;DICTIONARY ENTRY LOOK-UP UTILITY (FILE MANAGER COMPATIBLE) [ 12/23/86 1:53 PM ]
- +1 ;IHS-OKLA CITY AREA OFFICE-LMD
- L1 IF $DATA(D0)
- SET LKD0=D0
- IF $DATA(X)
- SET LKX=X
- IF $DATA(Y)#2
- SET LKY=Y
- KILL LKPCC,LKPRINT,LKDATA,LKERR,LKGL,LKDENT,LKNEW
- IF '$DATA(LKDR)!'$DATA(LKDIC)!'$DATA(LKDA)
- GOTO END
- SET LK("I")=1
- SET LKDIC(1)=LKDIC
- SET LKDR(1)=LKDR
- IF +LKDR<.01!(+LKDIC<1)!(+LKDA<1)
- GOTO END
- +1 IF $DATA(^DD(LKDIC,LKDR,0))
- SET LKG=^DD(LKDIC,LKDR,0)
- IF $PIECE(LKG,"^",2)["C"
- GOTO COMP
- IF +$PIECE(LKG,"^",2)>0
- SET LKERR=5
- GOTO END
- L2 IF '$DATA(^DD(LKDIC(LK("I")),LKDR(LK("I")),0))
- SET LKERR=3
- GOTO END
- +1 SET LKSUB=$PIECE(^DD(LKDIC(LK("I")),LKDR(LK("I")),0),"^",4)
- SET LKPC(LK("I"))=$PIECE(LKSUB,";",2)
- SET LKSUB(LK("I"))=$PIECE(LKSUB,";",1)
- IF '$DATA(^DD(LKDIC(LK("I")),0,"UP"))
- GOTO L4
- L3 SET LKERR=4
- IF $DATA(LKDRENT1)
- SET LKDRENT=0
- IF '$DATA(LKDRENT)
- GOTO END
- IF LKDRENT'="0"&(+LKDRENT<0)
- GOTO END
- IF LKDRENT\1'=LKDRENT
- GOTO END
- IF LKDRENT=0
- SET LKNEW=""
- KILL LKERR
- +1 SET LK("I")=LK("I")+1
- SET LKDIC(LK("I"))=^DD(LKDIC(LK("I")-1),0,"UP")
- SET LKDR(LK("I"))=0
- SET LKDR(LK("I"))=$ORDER(^DD(LKDIC(LK("I")),"SB",LKDIC(LK("I")-1),LKDR(LK("I"))))
- GOTO L2
- L4 SET LKGL=^DIC(LKDIC(LK("I")),0,"GL")_LKDA
- SET LKGL(1)=LKGL_",0)"
- IF '$DATA(@LKGL(1))
- SET LKERR=1
- GOTO END
- +1 IF LK("I")=1
- IF $DATA(LKDRENT)
- KILL LKDRENT
- GOTO L5
- +2 FOR LK("J")=LK("I"):-1:2
- SET LKGL=LKGL_","_LKSUB(LK("J"))
- IF LK("J")>2
- SET LKGL=LKGL_",1"
- L5 SET LKPCC=LKPC(1)
- IF '$DATA(LKDRENT)
- SET LKDRENT=""
- GOTO L6
- L5A SET LKGL(0)=LKGL_",0)"
- IF '$DATA(@LKGL(0))
- SET LKERR=6
- SET LKGL=LKGL_",1,0)"
- GOTO END
- L5B SET LKDENT=$PIECE(@LKGL(0),"^",4)
- IF LKDENT=""
- SET LKDENT=0
- IF LKDENT=0!(LKDRENT>LKDENT)
- SET LKERR=2
- GOTO END
- L5BB IF $DATA(LKDRENT1)
- DO DNT4
- IF LKDNT'=""
- GOTO L5E
- SET LKERR=2
- GOTO END
- L5C IF LKDRENT>0
- DO DNT2
- SET LKDRENT=LKDNT
- IF LKDNTT>0
- GOTO L5E
- SET LKERR=2
- GOTO END
- L5D SET LKGL(0)=LKGL_",0)"
- DO DNT
- L5E SET LKDRENT=","_LKDRENT
- L6 SET LKGL=LKGL_LKDRENT_","_LKSUB(1)_")"
- IF LKGL[",,"
- SET LKERR=2
- SET LKNEW=""
- GOTO END
- +1 IF '$DATA(@LKGL)
- SET LKERR=2
- SET LKNEW=""
- GOTO END
- L6A SET (LKPRINT,LKDATA)=$PIECE(@LKGL,"^",LKPC(1))
- IF LKPRINT=""
- GOTO END
- L7 SET LKGG=$PIECE(LKG,"^",2)
- SET LK("H")=$PIECE(LKG,"^",3)
- IF LKGG["S"
- GOTO SET
- IF LKGG["D"
- GOTO DATE
- IF LKGG["P"
- GOTO PTR
- IF LKGG["C"
- GOTO COMP
- IF $DATA(^DD(LKDIC(1),LKDR(1),2))
- GOTO TRX
- END IF $DATA(LKD0)
- SET D0=LKD0
- IF $DATA(LKX)
- SET X=LKX
- IF $DATA(LKY)
- SET Y=LKY
- KILL LKDIC,LKNEW,LKD0,LKX,LKY,LKDRENT,LKDRENT1,LKDNT,LKDNTT,LK,LKH,LKGG,LKGGG,LKGLL,LKSUB,LKPC,LKDR,LKDA
- IF '$DATA(LKPRINT)&'$DATA(LKERR)
- SET LKERR=0
- QUIT
- DNT SET LKDNT=0
- DNT1 SET LKGLL=LKGL_",LKDNT)"
- SET LKDNT=$ORDER(@LKGLL)
- IF LKDNT=""
- QUIT
- SET LKDRENT=LKDNT
- GOTO DNT1
- DNT2 SET (LKDNT,LKDNTT)=0
- DNT3 SET LKGLL=LKGL_",LKDNT)"
- SET LKDNT=$ORDER(@LKGLL)
- IF LKDNT=""
- QUIT
- SET LKDNTT=LKDNTT+1
- IF LKDNTT=LKDRENT
- QUIT
- GOTO DNT3
- DNT4 SET LKDNT=0
- DNT5 SET LKGLL=LKGL_",LKDNT)"
- SET LKDNT=$ORDER(@LKGLL)
- IF LKDNT=""
- QUIT
- IF LKDNT=LKDRENT1
- SET LKDRENT=LKDNT
- IF LKDRENT=LKDNT
- QUIT
- GOTO DNT5
- SET FOR LK("I")=1:1
- SET LKGGG=$PIECE(LK("H"),";",LK("I"))
- IF LKGGG=""
- GOTO END
- IF $PIECE(LKGGG,"
- SET LKPRINT=$PIECE(LKGGG,":",2)
- +1 GOTO END
- DATE SET Y=LKDATA
- XECUTE ^DD("DD")
- SET LKPRINT=Y
- GOTO END
- PTR SET LKGGG="^"_LK("H")_LKDATA_",0)"
- IF '$DATA(@LKGGG)
- SET LKERR=7
- GOTO END
- +1 SET LKPRINT=$PIECE(@LKGGG,"^",1)
- GOTO END
- COMP SET LKH=$EXTRACT($PIECE(LKG,";",2),3,999)
- SET D0=LKDA
- XECUTE LKH
- SET LKPRINT=X
- GOTO END
- TRX SET Y=LKDATA
- XECUTE ^DD(LKDIC(1),LKDR(1),2)
- SET LKPRINT=X
- GOTO END
