AICDKWLD.m

AICDKWLD ; IHS/OHPRD/ACC - DRIVER ROUTINE FOR "AND"ING INVERTED LIST SEARCHES ;

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

 ;IHS/CMI/LAB - CSV MODS

 ; AICDDESC,AICDH,AICDMULT,AICDREF0 ARE PASSED IN TO DISPLAY ROUTINES

 ;  AND SHOULD NOT BE KILLED IN THIS ROUTINE

 ; AICDKSCH,AICDX ARE KILLED BY AICDKWL

 ;

VERSION ; ENTRY POINT - DISPLAY VERSION (USED FROM MENUS)

 S X="KEYWORD-DRIVEN LOOKUP UTILITY (3.51)"

 S Y=$S(DUZ(2):$P(^DIC(4,DUZ(2),0),U),1:"No site selected")

 W @IOF,!,?(IOM-$L(X)/2),X,!,?(IOM-$L(Y)/2),Y,!

 Q

 ;

ICDDX ; PUBLISHED ENTRY POINT - LOOK UP ICD DIAGNOSIS CODE

 S AICDX=X K AICDKSCH S AICDKSCH("TYPE")="DIAGNOSES",AICDKSCH("GBL")="^ICD9(",AICDKSCH("INDEX")="AIHS",AICDKSCH("DSPLY")="DSPLYD^AICDKWLD" G COMMON

 ;

ICDOP ; PUBLISHED ENTRY POINT - LOOK UP ICD OPERATION/PROCEDURE CODE

 S AICDX=X K AICDKSCH S AICDKSCH("TYPE")="PROCEDURES",AICDKSCH("GBL")="^ICD0(",AICDKSCH("INDEX")="AIHS",AICDKSCH("DSPLY")="DSPLYO^AICDKWLD" G COMMON

 ;

CPTOP ; PUBLISHED ENTRY POINT - LOOK UP CPT CODE

 S AICDX=X K AICDKSCH S AICDKSCH("TYPE")="CPT PROCEDURES",AICDKSCH("GBL")="^ICPT(",AICDKSCH("INDEX")="C",AICDKSCH("DSPLY")="DSPLYC^AICDKWLD"

 ;

COMMON ; COMMON CODE FOR ALL TYPES OF LOOKUPS

 I $D(DIC(0)),DIC(0)["A" W !

 S X=AICDX,AICDX="" F %=1:1 S AICDC=$E(X,%) Q:AICDC=""  S:AICDC?1L AICDC=$C($A(AICDC)-32) S AICDX=AICDX_AICDC

 K AICDC

 D ^AICDKWL

 Q

DSPLYD ; DISPLAY CODE AND TEXT FOR DIAGNOSIS

 S %=3 G DSPCOM

DSPLYO ; DISPLAY CODE AND TEXT FOR OPERATION/PROCEDURE

 S %=4 G DSPCOM

DSPCOM ; COMMON DISPLAY CODE

 W:AICDMULT $J(AICDH,4),": "

 ;ihs/cmi/lab - csv, use $$ICDD call

 ;W $P(@(AICDREF0),"^",1)," ","(",$P(^(0),"^",%),")",! S AICDDESC=$S($D(^(1)):^(1),1:"<no long description available>")

 W $P(@(AICDREF0),"^",1)," ","(",$P(^(0),"^",%),")",!

 NEW N,AICDLD

 S N=$$ICDD^ICDCODE(AICDI,"AICDLD")

 I $P(N,"^",1)=-1 D  I 1

 .I AICDREF0["ICD0" S AICDDESC=$S($D(^ICD0(AICDI,1)):^ICD0(AICDI,1),1:"") I AICDDESC="" S AICDDESC=$P($$ICDOP^ICDCODE(AICDI,,,1),U,5)

 .I AICDREF0["ICD9" S AICDDESC=$S($D(^ICD9(AICDI,1)):^ICD9(AICDI,1),1:"") I AICDDESC="" S AICDDESC=$P($$ICDDX^ICDCODE(AICDI,,,1),U,4)

 E  S AICDDESC=$G(AICDLD(1))

 D DSPDESC^AICDKWL1

 Q

DSPLYC ; DISPLAY CODE AND TEXT FOR CPT PROCEDURE

 W:AICDMULT $J(AICDH,4),": "

 W $P(@(AICDREF0),"^",1)

 S AICDREFD=$P(AICDREF0,"0)",1)_"""D"",%)"

 F %=0:0 S %=$O(@(AICDREFD)) Q:'%  W ?15,^(%,0),!

 K AICDREFD

 Q

AICDKWLD  ; IHS/OHPRD/ACC - DRIVER ROUTINE FOR "AND"ING INVERTED LIST SEARCHES ;

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

 +2       ;IHS/CMI/LAB - CSV MODS

 +3       ; AICDDESC,AICDH,AICDMULT,AICDREF0 ARE PASSED IN TO DISPLAY ROUTINES

 +4       ;  AND SHOULD NOT BE KILLED IN THIS ROUTINE

 +5       ; AICDKSCH,AICDX ARE KILLED BY AICDKWL

 +6       ;

VERSION   ; ENTRY POINT - DISPLAY VERSION (USED FROM MENUS)

 +1        SET X="KEYWORD-DRIVEN LOOKUP UTILITY (3.51)"

 +2        SET Y=$SELECT(DUZ(2):$PIECE(^DIC(4,DUZ(2),0),U),1:"No site selected")

 +3        WRITE @IOF,!,?(IOM-$LENGTH(X)/2),X,!,?(IOM-$LENGTH(Y)/2),Y,!

 +4        QUIT 

 +5       ;

ICDDX     ; PUBLISHED ENTRY POINT - LOOK UP ICD DIAGNOSIS CODE

 +1        SET AICDX=X

           KILL AICDKSCH

           SET AICDKSCH("TYPE")="DIAGNOSES"

           SET AICDKSCH("GBL")="^ICD9("

           SET AICDKSCH("INDEX")="AIHS"

           SET AICDKSCH("DSPLY")="DSPLYD^AICDKWLD"

           GOTO COMMON

 +2       ;

ICDOP     ; PUBLISHED ENTRY POINT - LOOK UP ICD OPERATION/PROCEDURE CODE

 +1        SET AICDX=X

           KILL AICDKSCH

           SET AICDKSCH("TYPE")="PROCEDURES"

           SET AICDKSCH("GBL")="^ICD0("

           SET AICDKSCH("INDEX")="AIHS"

           SET AICDKSCH("DSPLY")="DSPLYO^AICDKWLD"

           GOTO COMMON

 +2       ;

CPTOP     ; PUBLISHED ENTRY POINT - LOOK UP CPT CODE

 +1        SET AICDX=X

           KILL AICDKSCH

           SET AICDKSCH("TYPE")="CPT PROCEDURES"

           SET AICDKSCH("GBL")="^ICPT("

           SET AICDKSCH("INDEX")="C"

           SET AICDKSCH("DSPLY")="DSPLYC^AICDKWLD"

 +2       ;

COMMON    ; COMMON CODE FOR ALL TYPES OF LOOKUPS

 +1        IF $DATA(DIC(0))

               IF DIC(0)["A"

                   WRITE !

 +2        SET X=AICDX

           SET AICDX=""

           FOR %=1:1

               SET AICDC=$EXTRACT(X,%)

               IF AICDC=""

                   QUIT 

               IF AICDC?1L

                   SET AICDC=$CHAR($ASCII(AICDC)-32)

               SET AICDX=AICDX_AICDC

 +3        KILL AICDC

 +4        DO ^AICDKWL

 +5        QUIT 

DSPLYD    ; DISPLAY CODE AND TEXT FOR DIAGNOSIS

 +1        SET %=3

           GOTO DSPCOM

DSPLYO    ; DISPLAY CODE AND TEXT FOR OPERATION/PROCEDURE

 +1        SET %=4

           GOTO DSPCOM

DSPCOM    ; COMMON DISPLAY CODE

 +1        IF AICDMULT

               WRITE $JUSTIFY(AICDH,4),": "

 +2       ;ihs/cmi/lab - csv, use $$ICDD call

 +3       ;W $P(@(AICDREF0),"^",1)," ","(",$P(^(0),"^",%),")",! S AICDDESC=$S($D(^(1)):^(1),1:"<no long description available>")

 +4        WRITE $PIECE(@(AICDREF0),"^",1)," ","(",$PIECE(^(0),"^",%),")",!

 +5        NEW N,AICDLD

 +6        SET N=$$ICDD^ICDCODE(AICDI,"AICDLD")

 +7        IF $PIECE(N,"^",1)=-1

               Begin DoDot:1

 +8                IF AICDREF0["ICD0"

                       SET AICDDESC=$SELECT($DATA(^ICD0(AICDI,1)):^ICD0(AICDI,1),1:"")

                       IF AICDDESC=""

                           SET AICDDESC=$PIECE($$ICDOP^ICDCODE(AICDI,,,1),U,5)

 +9                IF AICDREF0["ICD9"

                       SET AICDDESC=$SELECT($DATA(^ICD9(AICDI,1)):^ICD9(AICDI,1),1:"")

                       IF AICDDESC=""

                           SET AICDDESC=$PIECE($$ICDDX^ICDCODE(AICDI,,,1),U,4)

               End DoDot:1

               IF 1

 +10      IF '$TEST

               SET AICDDESC=$GET(AICDLD(1))

 +11       DO DSPDESC^AICDKWL1

 +12       QUIT 

DSPLYC    ; DISPLAY CODE AND TEXT FOR CPT PROCEDURE

 +1        IF AICDMULT

               WRITE $JUSTIFY(AICDH,4),": "

 +2        WRITE $PIECE(@(AICDREF0),"^",1)

 +3        SET AICDREFD=$PIECE(AICDREF0,"0)",1)_"""D"",%)"

 +4        FOR %=0:0

               SET %=$ORDER(@(AICDREFD))

               IF '%

                   QUIT 

               WRITE ?15,^(%,0),!

 +5        KILL AICDREFD

 +6        QUIT