AQAOCOD0.m

AQAOCOD0 ; IHS/ORDC/LJF - EXTENSION OF ROUTINE AQACODE ;

 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995

 ;IHS/ORDC/LJF; copy of rtn ^ATXCODE0;4.2;Taxonomy;;MAR 19, 1991

 ;  changes:  changed namespacing from ATX to AQA

 ;            added code checking AQAOICD to determine if ICD9 or ICD0

 ;            changed dir(?) to include procedures

 ;

 ;

INIT ;ENTRY POINT - initialize array; originally in ^ATXCODE

 S U="^",AQAO("NO DISPLAY")=0

 S:'$D(IOSL) IOP=$I D:'$D(IOSL) ^%ZIS I '$D(DTIME) D ^XBKVAR

 I $D(AQAOX) D  I 1

 .I $D(AQAOTBL) S AQAO("MODIFY")=1 D RANGES^AQAOCOD I 1

 .E  S AQAO("ENTER")=1

 E  S AQAO("NOT TAX")=""

 Q

 ;

LOOK ;ENTRY POINT - LOOKUP USER RESPONSE; SET UTILITY NODES

 S DIC=$S(AQAOICD=9:"^ICD9(",1:"^ICD0("),DIC(0)="EMF" D ^DIC K DIC,DR ;IHS/ORDC/LJF added code for ICD0

 I Y<0 S AQAOA=1 W *7,"  ??" S AQAO("NO DISPLAY")=1 G X3

 S:AQAOTYP="LOW" AQAO("LOW")=$S(AQAOICD=9:$P(^ICD9(+Y,0),U)_" ",1:$P(^ICD0(+Y,0),U)_" ") ;IHS/ORDC/LJF added code for ICD0

 I AQAOTYP="LOW",AQAONE S AQAO("HI")=AQAO("LOW") D ^AQAOCOD1

 I AQAOTYP="HI" S AQAO("HI")=$S(AQAOICD=9:$P(^ICD9(+Y,0),U)_" ",1:$P(^ICD0(+Y,0),U)_" ") D  I 'AQAO("NO DISPLAY") D DISPLAY^AQAOCOD,^AQAOCOD1 ;IHS/ORDC/LJF added code for ICD0

 .I $E(AQAO("HI"))?1N&($E(AQAO("LOW"))?1N)!($E(AQAO("LOW"))'?1N&($E(AQAO("HI"))'?1N))

 .E  W !,*7,"Low and high codes of range must both start either with a letter or a number.",! S AQAO("NO DISPLAY")=1

 .I 'AQAO("NO DISPLAY") I AQAO("LOW")]AQAO("HI") W !,*7,"Low code is higher than high code.",! S AQAO("NO DISPLAY")=1

X3 Q

 ;

SETDIR ;ENTRY POINT - SETS HELP AND DIR FOR INIT SUBROUTINE OF AQAOCOD

 ;

 ;IHS/ORDC/LJF original 6 lines of code from ^ATXCODE

 ;S DIR(0)="FO",DIR("?",1)="Enter ICD9 diagnosis code or narrative.  You may enter a range of",DIR("?",2)="codes by placing a ""-"" between two codes.  Codes in a range will"

 ;S DIR("?",3)="include the first and last codes indicated and all codes that fall",DIR("?",4)="between.  Only one code or one range of codes at a time.  You may"

 ;S DIR("?",5)="also enter ""[TAXONOMY NAME"" to select codes already within a taxonomy."

 ;S DIR("?",6)="You can also ""de-select"" a code or range of codes by placing a ""-"" in",DIR("?",7)="front of it. (e.g. '-250.00' or '-250.01-250.91')  Enter ""??"" to see"

 ;S DIR("?")="code ranges selected so far."

 ;S DIR("??")="^D ASK2^AQAOCOD0"

 ;

 ;IHS/ORDC/LJF new version of code

 S DIR(0)="FO"

 S DIR("?",1)="Enter ICD code or diagnosis/procedure narrative.  You may enter a range of"

 S DIR("?",2)="codes by placing a ""-"" between two codes.  Codes in a range will"

 S DIR("?",3)="include the first and last codes indicated and all codes that fall"

 S DIR("?",4)="between.  Only one code or one range of codes at a time.  You may also"

 S DIR("?",5)="enter ""[TAXONOMY NAME"" to select diagnosis codes already within a taxonomy."

 S DIR("?",6)="You can also ""de-select"" a code or range of codes by placing a ""-"" in"

 S DIR("?",7)="front of it. (e.g. '-250.00' or '-250.01-250.91').  To select ALL CODES"

 S DIR("?",8)="enter the letters ""ALL"" at the ENTER "_AQAOTL_" prompt."

 S DIR("?")="Enter ""??"" to see code ranges selected so far."

 S DIR("??")="^D ASK2^AQAOCOD0"

 Q

 ;

ASK2 ;ASKS USER IF WANTS TO DISPLAY/PRINT RESULTS TO THIS POINT

 I '$D(AQAOTBL) W !!,"A code range has yet to be selected.  A display cannot be generated.",! Q

 W !!,"Do you want to display the codes from a range you have already selected" S %=1 D YN^DICN I %=1 D SHOW^AQAOCOD

 I %=2!(%=-1) Q

 I %=0 W !!,"A table of ranges you have selected is displayed above.  You may ask for the",!,"codes in one of the ranges to be displayed.",! G ASK2

 Q

 ;

EOJ ;ENTRY POINT - end of job

 ;I $D(AQAO("NOT TAX")) K AQAOSTP,AQAOX

 ;K AQAOSUB,AQAOTYP,DFN,DIR,AQAOSAV,AQAOA,AQAOCT,AQAO,AQAOR,AQAOI,AQAONE,AQAOFLG

 Q

AQAOCOD0  ; IHS/ORDC/LJF - EXTENSION OF ROUTINE AQACODE ;

 +1       ;;1.01;QAI MANAGEMENT;;OCT 05, 1995

 +2       ;IHS/ORDC/LJF; copy of rtn ^ATXCODE0;4.2;Taxonomy;;MAR 19, 1991

 +3       ;  changes:  changed namespacing from ATX to AQA

 +4       ;            added code checking AQAOICD to determine if ICD9 or ICD0

 +5       ;            changed dir(?) to include procedures

 +6       ;

 +7       ;

INIT      ;ENTRY POINT - initialize array; originally in ^ATXCODE

 +1        SET U="^"

           SET AQAO("NO DISPLAY")=0

 +2        IF '$DATA(IOSL)

               SET IOP=$IO

           IF '$DATA(IOSL)

               DO ^%ZIS

           IF '$DATA(DTIME)

               DO ^XBKVAR

 +3        IF $DATA(AQAOX)

               Begin DoDot:1

 +4                IF $DATA(AQAOTBL)

                       SET AQAO("MODIFY")=1

                       DO RANGES^AQAOCOD

                       IF 1

 +5               IF '$TEST

                       SET AQAO("ENTER")=1

               End DoDot:1

               IF 1

 +6       IF '$TEST

               SET AQAO("NOT TAX")=""

 +7        QUIT 

 +8       ;

LOOK      ;ENTRY POINT - LOOKUP USER RESPONSE; SET UTILITY NODES

 +1       ;IHS/ORDC/LJF added code for ICD0

           SET DIC=$SELECT(AQAOICD=9:"^ICD9(",1:"^ICD0(")

           SET DIC(0)="EMF"

           DO ^DIC

           KILL DIC,DR

 +2        IF Y<0

               SET AQAOA=1

               WRITE *7,"  ??"

               SET AQAO("NO DISPLAY")=1

               GOTO X3

 +3       ;IHS/ORDC/LJF added code for ICD0

           IF AQAOTYP="LOW"

               SET AQAO("LOW")=$SELECT(AQAOICD=9:$PIECE(^ICD9(+Y,0),U)_" ",1:$PIECE(^ICD0(+Y,0),U)_" ")

 +4        IF AQAOTYP="LOW"

               IF AQAONE

                   SET AQAO("HI")=AQAO("LOW")

                   DO ^AQAOCOD1

 +5       ;IHS/ORDC/LJF added code for ICD0

           IF AQAOTYP="HI"

               SET AQAO("HI")=$SELECT(AQAOICD=9:$PIECE(^ICD9(+Y,0),U)_" ",1:$PIECE(^ICD0(+Y,0),U)_" ")

               Begin DoDot:1

 +6                IF $EXTRACT(AQAO("HI"))?1N&($EXTRACT(AQAO("LOW"))?1N)!($EXTRACT(AQAO("LOW"))'?1N&($EXTRACT(AQAO("HI"))'?1N))

 +7               IF '$TEST

                       WRITE !,*7,"Low and high codes of range must both start either with a letter or a number.",!

                       SET AQAO("NO DISPLAY")=1

 +8                IF 'AQAO("NO DISPLAY")

                       IF AQAO("LOW")]AQAO("HI")

                           WRITE !,*7,"Low code is higher than high code.",!

                           SET AQAO("NO DISPLAY")=1

               End DoDot:1

               IF 'AQAO("NO DISPLAY")

                   DO DISPLAY^AQAOCOD

                   DO ^AQAOCOD1

X3         QUIT 

 +1       ;

SETDIR    ;ENTRY POINT - SETS HELP AND DIR FOR INIT SUBROUTINE OF AQAOCOD

 +1       ;

 +2       ;IHS/ORDC/LJF original 6 lines of code from ^ATXCODE

 +3       ;S DIR(0)="FO",DIR("?",1)="Enter ICD9 diagnosis code or narrative.  You may enter a range of",DIR("?",2)="codes by placing a ""-"" between two codes.  Codes in a range will"

 +4       ;S DIR("?",3)="include the first and last codes indicated and all codes that fall",DIR("?",4)="between.  Only one code or one range of codes at a time.  You may"

 +5       ;S DIR("?",5)="also enter ""[TAXONOMY NAME"" to select codes already within a taxonomy."

 +6       ;S DIR("?",6)="You can also ""de-select"" a code or range of codes by placing a ""-"" in",DIR("?",7)="front of it. (e.g. '-250.00' or '-250.01-250.91')  Enter ""??"" to see"

 +7       ;S DIR("?")="code ranges selected so far."

 +8       ;S DIR("??")="^D ASK2^AQAOCOD0"

 +9       ;

 +10      ;IHS/ORDC/LJF new version of code

 +11       SET DIR(0)="FO"

 +12       SET DIR("?",1)="Enter ICD code or diagnosis/procedure narrative.  You may enter a range of"

 +13       SET DIR("?",2)="codes by placing a ""-"" between two codes.  Codes in a range will"

 +14       SET DIR("?",3)="include the first and last codes indicated and all codes that fall"

 +15       SET DIR("?",4)="between.  Only one code or one range of codes at a time.  You may also"

 +16       SET DIR("?",5)="enter ""[TAXONOMY NAME"" to select diagnosis codes already within a taxonomy."

 +17       SET DIR("?",6)="You can also ""de-select"" a code or range of codes by placing a ""-"" in"

 +18       SET DIR("?",7)="front of it. (e.g. '-250.00' or '-250.01-250.91').  To select ALL CODES"

 +19       SET DIR("?",8)="enter the letters ""ALL"" at the ENTER "_AQAOTL_" prompt."

 +20       SET DIR("?")="Enter ""??"" to see code ranges selected so far."

 +21       SET DIR("??")="^D ASK2^AQAOCOD0"

 +22       QUIT 

 +23      ;

ASK2      ;ASKS USER IF WANTS TO DISPLAY/PRINT RESULTS TO THIS POINT

 +1        IF '$DATA(AQAOTBL)

               WRITE !!,"A code range has yet to be selected.  A display cannot be generated.",!

               QUIT 

 +2        WRITE !!,"Do you want to display the codes from a range you have already selected"

           SET %=1

           DO YN^DICN

           IF %=1

               DO SHOW^AQAOCOD

 +3        IF %=2!(%=-1)

               QUIT 

 +4        IF %=0

               WRITE !!,"A table of ranges you have selected is displayed above.  You may ask for the",!,"codes in one of the ranges to be displayed.",!

               GOTO ASK2

 +5        QUIT 

 +6       ;

EOJ       ;ENTRY POINT - end of job

 +1       ;I $D(AQAO("NOT TAX")) K AQAOSTP,AQAOX

 +2       ;K AQAOSUB,AQAOTYP,DFN,DIR,AQAOSAV,AQAOA,AQAOCT,AQAO,AQAOR,AQAOI,AQAONE,AQAOFLG

 +3        QUIT