AICDKWL.m

AICDKWL ; IHS/OHPRD/ACC - LOOKUP DRIVER PROGRAM FOR "AND"ING INVERTED SEARCH ;

 ;;4.0;AICD;;DEC 03, 2014;Build 7

 ; ASSUMES AICDKSCH("TYPE"),("GBL"),("INDEX") AND AICDX

 ;IHS/CMI/LAB - CSV changed CHKSHRT to $$ICDDX

 S AICDXSAV=AICDX

 K Y

 S AICDT=AICDKSCH("TYPE"),AICDGBL=AICDKSCH("GBL"),AICDL=AICDX

 S AICDASK=$S('$D(DIC(0)):1,DIC(0)["E":1,1:0)

 I $D(^AICDKWLC("B",AICDT)) S AICDKWCT=$O(^AICDKWLC("B",AICDT,""))

 E  S AICDKWCT=0 W:AICDASK *7,"<WARNING: SYNONYM/REPLACEMENT TABLE MISSING>",!

INIT I AICDGBL'["^",AICDGBL'?1N.N,AICDGBL'?1N.N1"."1N.N S AICDGBL=$O(^DIC("B",AICDGBL,""))

 S:AICDGBL'["^" AICDGBL=^DIC(AICDGBL,0,"GL")

 S AICDREF=AICDGBL_""""_AICDKSCH("INDEX")_""",AICDWD)"

 S AICDREF1=AICDGBL

 S AICDREF2=$E(AICDREF,1,$L(AICDREF)-1)_","""")"

 S AICDREF3=AICDGBL_"^UTILITY(""AICDHITS"",$J,AICDH),0)"

 S AICDREF4=$E(AICDREF,1,$L(AICDREF)-1)_",AICDD)"

 ; NOTE: CHKSHRT HAS BEEN CHANGED TO USE "AB" BECAUSE THE

 ;       B INDEX NO LONGER EXISTS FOR ICD FILES -- NEEDS TO

 ;       BE IMPROVED TO PRESERVE GENERALITY OF LOOKUP!!!

CHKSHRT ;

 G:$L(AICDL)>40 NOTSHRT G:'$D(^AICDKWLC(AICDKWCT,3,"B",$E(AICDL,1,30))) NOTSHRT

 F AICDI=0:0 S AICDI=$O(^AICDKWLC(AICDKWCT,3,"B",$E(AICDL,1,30),AICDI)) Q:AICDI=""  Q:$P(^AICDKWLC(AICDKWCT,3,AICDI,0),U,1)=AICDL

 G:'AICDI NOTSHRT

 ;IHS/CMI/LAB - CSV commented line below and replaced

 ;S AICDL=$P(^AICDKWLC(AICDKWCT,3,AICDI,0),"^",2) S Y=$S($D(@(AICDREF1_"""AB"",AICDL)")):$O(^(AICDL,"")),1:-1)

 S AICDL=$P(^AICDKWLC(AICDKWCT,3,AICDI,0),"^",2) S Y=$P($$ICDDX^ICDCODE(AICDL,,,1),"^")

 G:Y<1 NOTSHRT

 I $D(@(AICDREF1_"Y,0)")) X:$D(DIC("S")) DIC("S") E  S Y=-1

 G:Y<1 NOTSHRT

 K ^UTILITY("AICDHITS",$J) S ^UTILITY("AICDHITS",$J)=1,^UTILITY("AICDHITS",$J,1)=Y G VERIFY

NOTSHRT ;

 G NOTSHRT^AICDKWL1

VERIFY ;

 G VERIFY^AICDKWL1

AICDKWL   ; IHS/OHPRD/ACC - LOOKUP DRIVER PROGRAM FOR "AND"ING INVERTED SEARCH ;

 +1       ;;4.0;AICD;;DEC 03, 2014;Build 7

 +2       ; ASSUMES AICDKSCH("TYPE"),("GBL"),("INDEX") AND AICDX

 +3       ;IHS/CMI/LAB - CSV changed CHKSHRT to $$ICDDX

 +4        SET AICDXSAV=AICDX

 +5        KILL Y

 +6        SET AICDT=AICDKSCH("TYPE")

           SET AICDGBL=AICDKSCH("GBL")

           SET AICDL=AICDX

 +7        SET AICDASK=$SELECT('$DATA(DIC(0)):1,DIC(0)["E":1,1:0)

 +8        IF $DATA(^AICDKWLC("B",AICDT))

               SET AICDKWCT=$ORDER(^AICDKWLC("B",AICDT,""))

 +9       IF '$TEST

               SET AICDKWCT=0

               IF AICDASK

                   WRITE *7,"<WARNING: SYNONYM/REPLACEMENT TABLE MISSING>",!

INIT       IF AICDGBL'["^"

               IF AICDGBL'?1N.N

                   IF AICDGBL'?1N.N1"."1N.N

                       SET AICDGBL=$ORDER(^DIC("B",AICDGBL,""))

 +1        IF AICDGBL'["^"

               SET AICDGBL=^DIC(AICDGBL,0,"GL")

 +2        SET AICDREF=AICDGBL_""""_AICDKSCH("INDEX")_""",AICDWD)"

 +3        SET AICDREF1=AICDGBL

 +4        SET AICDREF2=$EXTRACT(AICDREF,1,$LENGTH(AICDREF)-1)_","""")"

 +5        SET AICDREF3=AICDGBL_"^UTILITY(""AICDHITS"",$J,AICDH),0)"

 +6        SET AICDREF4=$EXTRACT(AICDREF,1,$LENGTH(AICDREF)-1)_",AICDD)"

 +7       ; NOTE: CHKSHRT HAS BEEN CHANGED TO USE "AB" BECAUSE THE

 +8       ;       B INDEX NO LONGER EXISTS FOR ICD FILES -- NEEDS TO

 +9       ;       BE IMPROVED TO PRESERVE GENERALITY OF LOOKUP!!!

CHKSHRT   ;

 +1        IF $LENGTH(AICDL)>40

               GOTO NOTSHRT

           IF '$DATA(^AICDKWLC(AICDKWCT,3,"B",$EXTRACT(AICDL,1,30)))

               GOTO NOTSHRT

 +2        FOR AICDI=0:0

               SET AICDI=$ORDER(^AICDKWLC(AICDKWCT,3,"B",$EXTRACT(AICDL,1,30),AICDI))

               IF AICDI=""

                   QUIT 

               IF $PIECE(^AICDKWLC(AICDKWCT,3,AICDI,0),U,1)=AICDL

                   QUIT 

 +3        IF 'AICDI

               GOTO NOTSHRT

 +4       ;IHS/CMI/LAB - CSV commented line below and replaced

 +5       ;S AICDL=$P(^AICDKWLC(AICDKWCT,3,AICDI,0),"^",2) S Y=$S($D(@(AICDREF1_"""AB"",AICDL)")):$O(^(AICDL,"")),1:-1)

 +6        SET AICDL=$PIECE(^AICDKWLC(AICDKWCT,3,AICDI,0),"^",2)

           SET Y=$PIECE($$ICDDX^ICDCODE(AICDL,,,1),"^")

 +7        IF Y<1

               GOTO NOTSHRT

 +8        IF $DATA(@(AICDREF1_"Y,0)"))

               IF $DATA(DIC("S"))

                   XECUTE DIC("S")

              IF '$TEST

                   SET Y=-1

 +9        IF Y<1

               GOTO NOTSHRT

 +10       KILL ^UTILITY("AICDHITS",$JOB)

           SET ^UTILITY("AICDHITS",$JOB)=1

           SET ^UTILITY("AICDHITS",$JOB,1)=Y

           GOTO VERIFY

NOTSHRT   ;

 +1        GOTO NOTSHRT^AICDKWL1

VERIFY    ;

 +1        GOTO VERIFY^AICDKWL1