AICDKSCH ; IHS/OHPRD/ACC - "AND"ING INVERTED LIST SEARCH ;
;;3.51;IHS ICD/CPT lookup & grouper;;MAY 30, 1991
; AICDNWDS,AICDREF1,AICDREF4,AICDWORD() ARE PASSED IN AND
; SHOULD NOT BE KILLED
K ^UTILITY("AICDHITS",$J) S ^UTILITY("AICDHITS",$J)=0
I $D(AICDHLIM) S AICDHLM1=AICDHLIM+1
E S AICDHLM1=0
S AICDCMAX=AICDDFN(1) F AICDI=1:1:AICDNWDS S:AICDDFN(AICDI)<AICDCMAX AICDCMAX=AICDDFN(AICDI)
RESTRT ;
S AICDI=0,AICDEMTY=0
SCLOOP ;
S AICDI=AICDI+1
G:AICDI>AICDNWDS!(AICDEMTY) ENDCHK
CMP S AICDLOW=AICDDFN(AICDI)<AICDCMAX,AICDHIGH=AICDDFN(AICDI)>AICDCMAX
I AICDLOW D INCSTK:AICDPRTL(AICDI),INCONE:'AICDPRTL(AICDI) G:'AICDEMTY CMP
I AICDHIGH S AICDCMAX=AICDDFN(AICDI),AICDI=0
G SCLOOP
ENDCHK ;
G:AICDEMTY EXIT
D NOTCHK W:AICDASK "." D:'AICDELIM CHKSCRN
I 'AICDELIM S ^UTILITY("AICDHITS",$J)=^UTILITY("AICDHITS",$J)+1,^UTILITY("AICDHITS",$J,^UTILITY("AICDHITS",$J))=AICDCMAX,AICDHLM1=AICDHLM1-1 G:AICDHLM1=0 STOP
S AICDCMAX=AICDCMAX+1
G RESTRT
STOP W !,"Too many terms meet your criteria; please refine your search.",! K ^UTILITY("AICDHITS",$J) S ^UTILITY("AICDHITS",$J)=0
EXIT K AICDEMTY,AICDHIGH,AICDLOW,AICDMDFN,AICDNUM,AICDCMAX,AICDHLM1
K AICDPRTL,AICDWORD,AICDAWRD,AICDDFN,AICDADFN,AICDELIM
K AICDWD,AICDD,AICDI,AICDJ,AICDQ
Q
;
NOTCHK ; CHECK POSSIBLE HIT FOR ELIMINATION BY "NOT"
S AICDELIM=0,AICDD=AICDCMAX
S AICDJ="" F AICDQ=0:0 S AICDJ=$O(AICDAWRD(0,AICDJ)) Q:AICDJ="" S AICDWD=AICDAWRD(0,AICDJ) I $D(@AICDREF4) S AICDELIM=1 Q
Q
;
CHKSCRN ; CHECK SCREEN
S Y=AICDCMAX I $D(@(AICDREF1_"Y,0)")) X:$D(DIC("S")) DIC("S") E S AICDELIM=1
Q
;
INCONE ; ADVANCE DFN FOR EXACT MATCH CASE
S AICDD=AICDDFN(AICDI),AICDWD=AICDWORD(AICDI)
S:AICDD<AICDCMAX AICDD=AICDCMAX-1
F AICDQ=0:0 S AICDD=$O(@AICDREF4) Q:AICDD=""!(AICDD'<AICDCMAX)
S AICDDFN(AICDI)=AICDD
S:AICDD="" AICDEMTY=1
Q
;
INCSTK ; ADVANCE COMPOSITE DFN FOR PARTIAL MATCH CASE
S AICDJ=0
F AICDQ=0:0 S AICDJ=$O(AICDAWRD(AICDI,AICDJ)) Q:AICDJ="" D INC1 Q:AICDD'=""
I AICDJ="" S (AICDD,AICDDFN(AICDI))="",AICDEMTY=1 Q
S AICDMDFN=AICDD
F AICDQ=0:0 S AICDJ=$O(AICDAWRD(AICDI,AICDJ)) Q:AICDJ="" D INC1 S:AICDD'=""&(AICDD<AICDMDFN) AICDMDFN=AICDD
S AICDDFN(AICDI)=AICDMDFN
Q
INC1 ;
S AICDD=AICDADFN(AICDI,AICDJ),AICDWD=AICDAWRD(AICDI,AICDJ)
Q:AICDADFN(AICDI,AICDJ)'<AICDCMAX
S AICDD=AICDCMAX-1
F AICDQ=0:0 S AICDD=$O(@AICDREF4) Q:AICDD=""!(AICDD'<AICDCMAX)
S:AICDD'="" AICDADFN(AICDI,AICDJ)=AICDD
K:AICDD="" AICDAWRD(AICDI,AICDJ),AICDADFN(AICDI,AICDJ)
Q
AICDKSCH ; IHS/OHPRD/ACC - "AND"ING INVERTED LIST SEARCH ;
+1 ;;3.51;IHS ICD/CPT lookup & grouper;;MAY 30, 1991
+2 ; AICDNWDS,AICDREF1,AICDREF4,AICDWORD() ARE PASSED IN AND
+3 ; SHOULD NOT BE KILLED
+4 KILL ^UTILITY("AICDHITS",$JOB)
SET ^UTILITY("AICDHITS",$JOB)=0
+5 IF $DATA(AICDHLIM)
SET AICDHLM1=AICDHLIM+1
+6 IF '$TEST
SET AICDHLM1=0
+7 SET AICDCMAX=AICDDFN(1)
FOR AICDI=1:1:AICDNWDS
IF AICDDFN(AICDI)<AICDCMAX
SET AICDCMAX=AICDDFN(AICDI)
RESTRT ;
+1 SET AICDI=0
SET AICDEMTY=0
SCLOOP ;
+1 SET AICDI=AICDI+1
+2 IF AICDI>AICDNWDS!(AICDEMTY)
GOTO ENDCHK
CMP SET AICDLOW=AICDDFN(AICDI)<AICDCMAX
SET AICDHIGH=AICDDFN(AICDI)>AICDCMAX
+1 IF AICDLOW
IF AICDPRTL(AICDI)
DO INCSTK
IF 'AICDPRTL(AICDI)
DO INCONE
IF 'AICDEMTY
GOTO CMP
+2 IF AICDHIGH
SET AICDCMAX=AICDDFN(AICDI)
SET AICDI=0
+3 GOTO SCLOOP
ENDCHK ;
+1 IF AICDEMTY
GOTO EXIT
+2 DO NOTCHK
IF AICDASK
WRITE "."
IF 'AICDELIM
DO CHKSCRN
+3 IF 'AICDELIM
SET ^UTILITY("AICDHITS",$JOB)=^UTILITY("AICDHITS",$JOB)+1
SET ^UTILITY("AICDHITS",$JOB,^UTILITY("AICDHITS",$JOB))=AICDCMAX
SET AICDHLM1=AICDHLM1-1
IF AICDHLM1=0
GOTO STOP
+4 SET AICDCMAX=AICDCMAX+1
+5 GOTO RESTRT
STOP WRITE !,"Too many terms meet your criteria; please refine your search.",!
KILL ^UTILITY("AICDHITS",$JOB)
SET ^UTILITY("AICDHITS",$JOB)=0
EXIT KILL AICDEMTY,AICDHIGH,AICDLOW,AICDMDFN,AICDNUM,AICDCMAX,AICDHLM1
+1 KILL AICDPRTL,AICDWORD,AICDAWRD,AICDDFN,AICDADFN,AICDELIM
+2 KILL AICDWD,AICDD,AICDI,AICDJ,AICDQ
+3 QUIT
+4 ;
NOTCHK ; CHECK POSSIBLE HIT FOR ELIMINATION BY "NOT"
+1 SET AICDELIM=0
SET AICDD=AICDCMAX
+2 SET AICDJ=""
FOR AICDQ=0:0
SET AICDJ=$ORDER(AICDAWRD(0,AICDJ))
IF AICDJ=""
QUIT
SET AICDWD=AICDAWRD(0,AICDJ)
IF $DATA(@AICDREF4)
SET AICDELIM=1
QUIT
+3 QUIT
+4 ;
CHKSCRN ; CHECK SCREEN
+1 SET Y=AICDCMAX
IF $DATA(@(AICDREF1_"Y,0)"))
IF $DATA(DIC("S"))
XECUTE DIC("S")
IF '$TEST
SET AICDELIM=1
+2 QUIT
+3 ;
INCONE ; ADVANCE DFN FOR EXACT MATCH CASE
+1 SET AICDD=AICDDFN(AICDI)
SET AICDWD=AICDWORD(AICDI)
+2 IF AICDD<AICDCMAX
SET AICDD=AICDCMAX-1
+3 FOR AICDQ=0:0
SET AICDD=$ORDER(@AICDREF4)
IF AICDD=""!(AICDD'<AICDCMAX)
QUIT
+4 SET AICDDFN(AICDI)=AICDD
+5 IF AICDD=""
SET AICDEMTY=1
+6 QUIT
+7 ;
INCSTK ; ADVANCE COMPOSITE DFN FOR PARTIAL MATCH CASE
+1 SET AICDJ=0
+2 FOR AICDQ=0:0
SET AICDJ=$ORDER(AICDAWRD(AICDI,AICDJ))
IF AICDJ=""
QUIT
DO INC1
IF AICDD'=""
QUIT
+3 IF AICDJ=""
SET (AICDD,AICDDFN(AICDI))=""
SET AICDEMTY=1
QUIT
+4 SET AICDMDFN=AICDD
+5 FOR AICDQ=0:0
SET AICDJ=$ORDER(AICDAWRD(AICDI,AICDJ))
IF AICDJ=""
QUIT
DO INC1
IF AICDD'=""&(AICDD<AICDMDFN)
SET AICDMDFN=AICDD
+6 SET AICDDFN(AICDI)=AICDMDFN
+7 QUIT
INC1 ;
+1 SET AICDD=AICDADFN(AICDI,AICDJ)
SET AICDWD=AICDAWRD(AICDI,AICDJ)
+2 IF AICDADFN(AICDI,AICDJ)'<AICDCMAX
QUIT
+3 SET AICDD=AICDCMAX-1
+4 FOR AICDQ=0:0
SET AICDD=$ORDER(@AICDREF4)
IF AICDD=""!(AICDD'<AICDCMAX)
QUIT
+5 IF AICDD'=""
SET AICDADFN(AICDI,AICDJ)=AICDD
+6 IF AICDD=""
KILL AICDAWRD(AICDI,AICDJ),AICDADFN(AICDI,AICDJ)
+7 QUIT
