- AUDICLK ;DICTIONARY ENTRY LOOK-UP UTILITY [ 11/01/90 11:16 AM ]
- ;IHS-OKLA CITY AREA OFFICE-LMD
- L1 K PCC,LKPRINT,LKDATA,LKERR,GL,DENT,NEW G END:'$D(DR)!'$D(DIC)!'$D(DA) S LK("I")=1,DIC(1)=DIC,DR(1)=DR G END:+DR<.01!(+DIC<1)!(+DA<1)
- I $D(^DD(DIC,DR,0)) S G=^DD(DIC,DR,0) G COMP:$P(G,"^",2)["C" I +$P(G,"^",2)>0 S LKERR=5 G END
- L2 I '$D(^DD(DIC(LK("I")),DR(LK("I")),0)) S LKERR=3 G END
- S SUB=$P(^DD(DIC(LK("I")),DR(LK("I")),0),"^",4),PC(LK("I"))=$P(SUB,";",2),SUB(LK("I"))=$P(SUB,";",1) I '$D(^DD(DIC(LK("I")),0,"UP")) G L4
- L3 S LKERR=4 S:$D(DRENT1) DRENT=0 G END:'$D(DRENT) G END:DRENT'="0"&(+DRENT<0) G END:DRENT\1'=DRENT S:DRENT=0 NEW="" K LKERR
- S LK("I")=LK("I")+1,DIC(LK("I"))=^DD(DIC(LK("I")-1),0,"UP"),DR(LK("I"))=0,DR(LK("I"))=$O(^DD(DIC(LK("I")),"SB",DIC(LK("I")-1),DR(LK("I")))) G L2
- L4 S GL=^DIC(DIC(LK("I")),0,"GL")_DA,GL(1)=GL_",0)" I '$D(@GL(1)) S LKERR=1 G END
- I LK("I")=1 K:$D(DRENT) DRENT G L5
- F LK("J")=LK("I"):-1:2 S GL=GL_","_SUB(LK("J")) S:LK("J")>2 GL=GL_",1"
- L5 S PCC=PC(1) I '$D(DRENT) S DRENT="" G L6
- L5A S GL(0)=GL_",0)" I '$D(@GL(0)) S LKERR=6,GL=GL_",1,0)" G END
- L5B S DENT=$P(@GL(0),"^",4) S:DENT="" DENT=0 I DENT=0!(DRENT>DENT) S LKERR=2 G END
- L5BB I $D(DRENT1) D DNT4 G L5E:DNT'="" S LKERR=2 G END
- L5C I DRENT>0 D DNT2 S DRENT=DNT G L5E:DNTT>0 S LKERR=2 G END
- L5D S GL(0)=GL_",0)" D DNT
- L5E S DRENT=","_DRENT
- L6 S GL=GL_DRENT_","_SUB(1)_")" I GL[",," S LKERR=2,NEW="" G END
- I '$D(@GL) S LKERR=2,NEW="" G END
- L6A S (LKPRINT,LKDATA)=$P(@GL,"^",PC(1)) G END:LKPRINT=""
- L7 S GG=$P(G,"^",2),LK("H")=$P(G,"^",3) G SET:GG["S",DATE:GG["D",PTR:GG["P",TRX:$D(^DD(DIC(1),DR(1),2))
- END K DRENT,DRENT1,D0,DNT,DNTT,LK,LKH,GG,GGG,GLL,SUB,PS S:'$D(LKPRINT)&'$D(LKERR) LKERR=0 Q
- DNT S DNT=0
- DNT1 S GLL=GL_",DNT)",DNT=$O(@GLL) Q:DNT'=+DNT S DRENT=DNT G DNT1
- DNT2 S (DNT,DNTT)=0
- DNT3 S GLL=GL_",DNT)",DNT=$O(@GLL) Q:DNT="" S DNTT=DNTT+1 Q:DNTT=DRENT G DNT3
- DNT4 S DNT=0
- DNT5 S GLL=GL_",DNT)",DNT=$O(@GLL) Q:DNT="" S:DNT=DRENT1 DRENT=DNT Q:DRENT=DNT G DNT5
- SET F LK("I")=1:1 S GGG=$P(LK("H"),";",LK("I")) G END:GGG="" S:$P(GGG,":",1)=LKDATA LKPRINT=$P(GGG,":",2)
- G END
- DATE S Y=LKDATA X ^DD("DD") S LKPRINT=Y G END
- PTR S GGG="^"_LK("H")_LKDATA_",0)" I '$D(@GGG) S LKERR=7 G END
- S LKPRINT=$P(@GGG,"^",1) G END
- COMP S LKH=$E($P(G,";",2),3,999),D0=DA X LKH S LKPRINT=X G END
- TRX S Y=LKDATA X ^DD(DIC(1),DR(1),2) S LKPRINT=Y G END
- AUDICLK ;DICTIONARY ENTRY LOOK-UP UTILITY [ 11/01/90 11:16 AM ]
- +1 ;IHS-OKLA CITY AREA OFFICE-LMD
- L1 KILL PCC,LKPRINT,LKDATA,LKERR,GL,DENT,NEW
- IF '$DATA(DR)!'$DATA(DIC)!'$DATA(DA)
- GOTO END
- SET LK("I")=1
- SET DIC(1)=DIC
- SET DR(1)=DR
- IF +DR<.01!(+DIC<1)!(+DA<1)
- GOTO END
- +1 IF $DATA(^DD(DIC,DR,0))
- SET G=^DD(DIC,DR,0)
- IF $PIECE(G,"^",2)["C"
- GOTO COMP
- IF +$PIECE(G,"^",2)>0
- SET LKERR=5
- GOTO END
- L2 IF '$DATA(^DD(DIC(LK("I")),DR(LK("I")),0))
- SET LKERR=3
- GOTO END
- +1 SET SUB=$PIECE(^DD(DIC(LK("I")),DR(LK("I")),0),"^",4)
- SET PC(LK("I"))=$PIECE(SUB,";",2)
- SET SUB(LK("I"))=$PIECE(SUB,";",1)
- IF '$DATA(^DD(DIC(LK("I")),0,"UP"))
- GOTO L4
- L3 SET LKERR=4
- IF $DATA(DRENT1)
- SET DRENT=0
- IF '$DATA(DRENT)
- GOTO END
- IF DRENT'="0"&(+DRENT<0)
- GOTO END
- IF DRENT\1'=DRENT
- GOTO END
- IF DRENT=0
- SET NEW=""
- KILL LKERR
- +1 SET LK("I")=LK("I")+1
- SET DIC(LK("I"))=^DD(DIC(LK("I")-1),0,"UP")
- SET DR(LK("I"))=0
- SET DR(LK("I"))=$ORDER(^DD(DIC(LK("I")),"SB",DIC(LK("I")-1),DR(LK("I"))))
- GOTO L2
- L4 SET GL=^DIC(DIC(LK("I")),0,"GL")_DA
- SET GL(1)=GL_",0)"
- IF '$DATA(@GL(1))
- SET LKERR=1
- GOTO END
- +1 IF LK("I")=1
- IF $DATA(DRENT)
- KILL DRENT
- GOTO L5
- +2 FOR LK("J")=LK("I"):-1:2
- SET GL=GL_","_SUB(LK("J"))
- IF LK("J")>2
- SET GL=GL_",1"
- L5 SET PCC=PC(1)
- IF '$DATA(DRENT)
- SET DRENT=""
- GOTO L6
- L5A SET GL(0)=GL_",0)"
- IF '$DATA(@GL(0))
- SET LKERR=6
- SET GL=GL_",1,0)"
- GOTO END
- L5B SET DENT=$PIECE(@GL(0),"^",4)
- IF DENT=""
- SET DENT=0
- IF DENT=0!(DRENT>DENT)
- SET LKERR=2
- GOTO END
- L5BB IF $DATA(DRENT1)
- DO DNT4
- IF DNT'=""
- GOTO L5E
- SET LKERR=2
- GOTO END
- L5C IF DRENT>0
- DO DNT2
- SET DRENT=DNT
- IF DNTT>0
- GOTO L5E
- SET LKERR=2
- GOTO END
- L5D SET GL(0)=GL_",0)"
- DO DNT
- L5E SET DRENT=","_DRENT
- L6 SET GL=GL_DRENT_","_SUB(1)_")"
- IF GL[",,"
- SET LKERR=2
- SET NEW=""
- GOTO END
- +1 IF '$DATA(@GL)
- SET LKERR=2
- SET NEW=""
- GOTO END
- L6A SET (LKPRINT,LKDATA)=$PIECE(@GL,"^",PC(1))
- IF LKPRINT=""
- GOTO END
- L7 SET GG=$PIECE(G,"^",2)
- SET LK("H")=$PIECE(G,"^",3)
- IF GG["S"
- GOTO SET
- IF GG["D"
- GOTO DATE
- IF GG["P"
- GOTO PTR
- IF $DATA(^DD(DIC(1),DR(1),2))
- GOTO TRX
- END KILL DRENT,DRENT1,D0,DNT,DNTT,LK,LKH,GG,GGG,GLL,SUB,PS
- IF '$DATA(LKPRINT)&'$DATA(LKERR)
- SET LKERR=0
- QUIT
- DNT SET DNT=0
- DNT1 SET GLL=GL_",DNT)"
- SET DNT=$ORDER(@GLL)
- IF DNT'=+DNT
- QUIT
- SET DRENT=DNT
- GOTO DNT1
- DNT2 SET (DNT,DNTT)=0
- DNT3 SET GLL=GL_",DNT)"
- SET DNT=$ORDER(@GLL)
- IF DNT=""
- QUIT
- SET DNTT=DNTT+1
- IF DNTT=DRENT
- QUIT
- GOTO DNT3
- DNT4 SET DNT=0
- DNT5 SET GLL=GL_",DNT)"
- SET DNT=$ORDER(@GLL)
- IF DNT=""
- QUIT
- IF DNT=DRENT1
- SET DRENT=DNT
- IF DRENT=DNT
- QUIT
- GOTO DNT5
- SET FOR LK("I")=1:1
- SET GGG=$PIECE(LK("H"),";",LK("I"))
- IF GGG=""
- GOTO END
- IF $PIECE(GGG,"
- SET LKPRINT=$PIECE(GGG,":",2)
- +1 GOTO END
- DATE SET Y=LKDATA
- XECUTE ^DD("DD")
- SET LKPRINT=Y
- GOTO END
- PTR SET GGG="^"_LK("H")_LKDATA_",0)"
- IF '$DATA(@GGG)
- SET LKERR=7
- GOTO END
- +1 SET LKPRINT=$PIECE(@GGG,"^",1)
- GOTO END
- COMP SET LKH=$EXTRACT($PIECE(G,";",2),3,999)
- SET D0=DA
- XECUTE LKH
- SET LKPRINT=X
- GOTO END
- TRX SET Y=LKDATA
- XECUTE ^DD(DIC(1),DR(1),2)
- SET LKPRINT=Y
- GOTO END
