AMQQTXC.m

AMQQTXC ; IHS/CMI/THL - CODE RANGE TAXONOMY ; 17 Mar 2014  2:25 PM

 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58

 ;-----

 K AMQQXSAV

 ;I ^DD("VERSION")<22 S DIC=$S($G(DUZ("AG"))="I":"@AMQQTGBL@(",1:AMQQTGBL_"(")

 I AMQQTGBL="^ICD9"!(AMQQTGBL="^ICD0"),'$G(AMQQISYS) S AMQQXSAV=X D ICDCS^AMQQTXG I AMQQISYS="" W !!,"You must indicate the coding system (ICD9 or ICD10).",! K AMQQISYS,AMQQXSAV S X=U,Y=-1 S AMQQA=1 S AMQQ("NO DISPLAY")=1 Q

 I $D(AMQQXSAV) S X=AMQQXSAV

 S DIC=AMQQTGBL_"("

 S DIC(0)="EMF"

 I $D(AMQQXX),$D(AMQQNECO) S DIC(0)="MF"

 I $G(AMQQSQNM)="CAUSE OF INJURY (PRIMARY)" S DIC("S")="I $$CAUSE^APCDAPOV(+Y,AMQQISYS)"

 E  I AMQQTGBL="^ICD9" S DIC("S")="I '$$CAUSE^APCDAPOV(+Y,AMQQISYS)"

 I AMQQTGBL="^ICD9"!(AMQQTGBL="^ICD0") S ICDSYS=AMQQISYS

 D ^DIC

 K DIC,DR

 I Y<0 S AMQQA=1 W:'$D(DUOUT) *7,"  ?? ",X," => Code does not exist!" S AMQQ("NO DISPLAY")=1 Q

 S:AMQQTYP="LOW" AMQQ("LOW")=$P(@AMQQTGBL@(+Y,0),U)_" "

 I AMQQTYP="LOW",AMQQONE S AMQQ("HI")=AMQQ("LOW") D ^AMQQTXC1

 I AMQQTYP="HI" S AMQQ("HI")=$P(@AMQQTGBL@(+Y,0),U)_" " D L1 I 'AMQQ("NO DISPLAY") D DISPLAY Q:$D(AMQQQUIT)  D ^AMQQTXC1

EXIT K %,AMQQXSAV

 Q

 ;

L1 I $E(AMQQ("HI"))?1N&($E(AMQQ("LOW"))?1N)!($E(AMQQ("LOW"))'?1N&($E(AMQQ("HI"))'?1N))

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

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

 Q

 ;

DISPLAY ;SHOW CODES IN RANGE SELECTED

 W:$D(IOF) @IOF

 W !!,"Codes in this range =>",!!

 ;I AMQQTGBL="^ICD9"!(AMQQTGBL="^ICD0") D ICDL Q

 W $P(AMQQ("LOW")," ")

 S AMQQDFN=$O(@AMQQTGBL@("BA",AMQQ("LOW"),""))

 W ?9,$S(AMQQTGBL="^ICPT":$P(@AMQQTGBL@(AMQQDFN,0),U,2),AMQQTGBL="^ICD9":$P($$ICDDX^ICDEX(AMQQDFN),U,4),1:$P($$ICDOP^ICDEX(AMQQDFN,"","","I"),U,5))

 S AMQQ=AMQQ("LOW")

 S AMQQCNT=IOSL-5

 S AMQQDFN=$O(@AMQQTGBL@("BA",AMQQ,""))

 D A1

 F  S AMQQ=$O(@AMQQTGBL@("BA",AMQQ)) Q:AMQQ=""!(AMQQ]AMQQ("HI"))  S AMQQDFN=$O(^(AMQQ,"")) D

 .I AMQQTGBL="^ICD9" Q:$P($$ICDDX^ICDEX(AMQQDFN),U,20)'=AMQQISYS

 .I AMQQTGBL="^ICD0" Q:$P($$ICDOP^ICDEX(AMQQDFN,"","","I"),U,15)'=AMQQISYS

 .I $D(AMQQTJMP) W "." S ^UTILITY("AMQQ TAX",$J,AMQQURGN,AMQQDFN)="""" Q

 .W !,$P(AMQQ," "),?9,$S(AMQQTGBL="^ICPT":$P(@AMQQTGBL@(AMQQDFN,0),U,2),AMQQTGBL="^ICD9":$P($$ICDDX^ICDEX(AMQQDFN),U,4),AMQQTGBL="^ICD0":$P($$ICDOP^ICDEX(AMQQDFN,"","","I"),U,5),1:$P(@AMQQTGBL@(AMQQDFN,0),U,3)) D A1 I $D(AMQQQUIT) Q

 K AMQQTJMP

 I $S('$D(AMQQR):1,AMQQR'=U:1,1:0) R !!,"Press return to continue",AMQQR:DTIME E  S AMQQR=U

 I AMQQR=U Q

 W !

 Q

 ;

A1 S AMQQCNT=AMQQCNT-1

 I '$D(AMQQTXEX) S ^UTILITY("AMQQ TAX",$J,AMQQURGN,AMQQDFN)=""

 E  K ^UTILITY("AMQQ TAX",$J,AMQQURGN,AMQQDFN)

 I AMQQCNT Q

A11 S AMQQCNT=IOSL-4

 R !,"<>",AMQQR:DTIME E  S AMQQR=U

 I AMQQR=U S AMQQTJMP="" W !,"OK" Q

 I AMQQR["?" W " Enter ""^"" to stop display, return to continue" G A11

 Q

 ;

RANGES ; ENTRY POINT FROM AMQQTXG1 ; DISPLAY TABLE OF ALL RANGES

 I $D(AMQQXX) Q

 W:$D(IOF) @IOF

 I '$D(AMQQNECO) W !!,"Code Range(s) Selected So Far =>",!

 S (AMQQ("NUM"),AMQQ)=0

 F  S AMQQ=$O(@AMQQHILO@(AMQQ)) Q:AMQQ=""  S AMQQ("NUM")=AMQQ("NUM")+1 W !,AMQQ("NUM"),")  ",AMQQ,$S(AMQQ'=$P(@AMQQHILO@(AMQQ),U,1):"- "_$P(@AMQQHILO@(AMQQ),U,1),1:"") W:$P(@AMQQHILO@(AMQQ),U,3) $P(^ICDS($P(@AMQQHILO@(AMQQ),U,3),0),U,1)

 I '$D(AMQQ("BANG")) W !

 Q

 ;

SHOW ; ENTRY POINT FROM AMQQTXG1 ; ALLOW USER TO SELECT FROM RANGES TO DISPLAY CODES

 D RANGES

 I AMQQ("NUM")=1 S X=1 G AA

A W !,"Enter an Item Number from the table above to display code(s): "

 R X:DTIME E  S X=U

 I X?1."?" W !!,"Enter a number between 1 and ",AMQQ("NUM"),! G A

 I X=U Q

 I X,X'>AMQQ("NUM"),X?1N

 E  W "  ??",*7 G A

AA S AMQQ("N")=X

 F AMQQI=1:AMQQ("N") S AMQQ=$O(@AMQQHILO@(AMQQ)) I AMQQI=AMQQ("N") S AMQQ("LOW")=AMQQ,AMQQ("HI")=@AMQQHILO@(AMQQ) D DISPLAY Q

 S AMQQ("BANG")=""

 D RANGES

 K AMQQ("BANG")

 Q

 ;

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

 I '$D(@AMQQHILO) 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

 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

 ;

AMQQTXC   ; IHS/CMI/THL - CODE RANGE TAXONOMY ; 17 Mar 2014  2:25 PM

 +1       ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58

 +2       ;-----

 +3        KILL AMQQXSAV

 +4       ;I ^DD("VERSION")<22 S DIC=$S($G(DUZ("AG"))="I":"@AMQQTGBL@(",1:AMQQTGBL_"(")

 +5        IF AMQQTGBL="^ICD9"!(AMQQTGBL="^ICD0")

               IF '$GET(AMQQISYS)

                   SET AMQQXSAV=X

                   DO ICDCS^AMQQTXG

                   IF AMQQISYS=""

                       WRITE !!,"You must indicate the coding system (ICD9 or ICD10).",!

                       KILL AMQQISYS,AMQQXSAV

                       SET X=U

                       SET Y=-1

                       SET AMQQA=1

                       SET AMQQ("NO DISPLAY")=1

                       QUIT 

 +6        IF $DATA(AMQQXSAV)

               SET X=AMQQXSAV

 +7        SET DIC=AMQQTGBL_"("

 +8        SET DIC(0)="EMF"

 +9        IF $DATA(AMQQXX)

               IF $DATA(AMQQNECO)

                   SET DIC(0)="MF"

 +10       IF $GET(AMQQSQNM)="CAUSE OF INJURY (PRIMARY)"

               SET DIC("S")="I $$CAUSE^APCDAPOV(+Y,AMQQISYS)"

 +11      IF '$TEST

               IF AMQQTGBL="^ICD9"

                   SET DIC("S")="I '$$CAUSE^APCDAPOV(+Y,AMQQISYS)"

 +12       IF AMQQTGBL="^ICD9"!(AMQQTGBL="^ICD0")

               SET ICDSYS=AMQQISYS

 +13       DO ^DIC

 +14       KILL DIC,DR

 +15       IF Y<0

               SET AMQQA=1

               IF '$DATA(DUOUT)

                   WRITE *7,"  ?? ",X," => Code does not exist!"

               SET AMQQ("NO DISPLAY")=1

               QUIT 

 +16       IF AMQQTYP="LOW"

               SET AMQQ("LOW")=$PIECE(@AMQQTGBL@(+Y,0),U)_" "

 +17       IF AMQQTYP="LOW"

               IF AMQQONE

                   SET AMQQ("HI")=AMQQ("LOW")

                   DO ^AMQQTXC1

 +18       IF AMQQTYP="HI"

               SET AMQQ("HI")=$PIECE(@AMQQTGBL@(+Y,0),U)_" "

               DO L1

               IF 'AMQQ("NO DISPLAY")

                   DO DISPLAY

                   IF $DATA(AMQQQUIT)

                       QUIT 

                   DO ^AMQQTXC1

EXIT       KILL %,AMQQXSAV

 +1        QUIT 

 +2       ;

L1         IF $EXTRACT(AMQQ("HI"))?1N&($EXTRACT(AMQQ("LOW"))?1N)!($EXTRACT(AMQQ("LOW"))'?1N&($EXTRACT(AMQQ("HI"))'?1N))

 +1       IF '$TEST

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

               SET AMQQ("NO DISPLAY")=1

 +2        IF 'AMQQ("NO DISPLAY")

               IF AMQQ("LOW")]AMQQ("HI")

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

                   SET AMQQ("NO DISPLAY")=1

 +3        QUIT 

 +4       ;

DISPLAY   ;SHOW CODES IN RANGE SELECTED

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE !!,"Codes in this range =>",!!

 +3       ;I AMQQTGBL="^ICD9"!(AMQQTGBL="^ICD0") D ICDL Q

 +4        WRITE $PIECE(AMQQ("LOW")," ")

 +5        SET AMQQDFN=$ORDER(@AMQQTGBL@("BA",AMQQ("LOW"),""))

 +6        WRITE ?9,$SELECT(AMQQTGBL="^ICPT":$PIECE(@AMQQTGBL@(AMQQDFN,0),U,2),AMQQTGBL="^ICD9":$PIECE($$ICDDX^ICDEX(AMQQDFN),U,4),1:$PIECE($$ICDOP^ICDEX(AMQQDFN,"","","I"),U,5))

 +7        SET AMQQ=AMQQ("LOW")

 +8        SET AMQQCNT=IOSL-5

 +9        SET AMQQDFN=$ORDER(@AMQQTGBL@("BA",AMQQ,""))

 +10       DO A1

 +11       FOR 

               SET AMQQ=$ORDER(@AMQQTGBL@("BA",AMQQ))

               IF AMQQ=""!(AMQQ]AMQQ("HI"))

                   QUIT 

               SET AMQQDFN=$ORDER(^(AMQQ,""))

               Begin DoDot:1

 +12               IF AMQQTGBL="^ICD9"

                       IF $PIECE($$ICDDX^ICDEX(AMQQDFN),U,20)'=AMQQISYS

                           QUIT 

 +13               IF AMQQTGBL="^ICD0"

                       IF $PIECE($$ICDOP^ICDEX(AMQQDFN,"","","I"),U,15)'=AMQQISYS

                           QUIT 

 +14               IF $DATA(AMQQTJMP)

                       WRITE "."

                       SET ^UTILITY("AMQQ TAX",$JOB,AMQQURGN,AMQQDFN)=""""

                       QUIT 

 +15               WRITE !,$PIECE(AMQQ," "),?9,$SELECT(AMQQTGBL="^ICPT":$PIECE(@AMQQTGBL@(AMQQDFN,0),U,2),AMQQTGBL="^ICD9":$PIECE($$ICDDX^ICDEX(AMQQDFN),U,4),AMQQTGBL="^ICD0":$PIECE($$ICDOP^ICDEX(AMQQDFN,"","","I"),U,5),1:$PIECE(@AMQQTGBL@(AMQQDFN,0),U,3)

)

                   DO A1

                   IF $DATA(AMQQQUIT)

                       QUIT 

               End DoDot:1

 +16       KILL AMQQTJMP

 +17       IF $SELECT('$DATA(AMQQR):1,AMQQR'=U:1,1:0)

               READ !!,"Press return to continue",AMQQR:DTIME

              IF '$TEST

                   SET AMQQR=U

 +18       IF AMQQR=U

               QUIT 

 +19       WRITE !

 +20       QUIT 

 +21      ;

A1         SET AMQQCNT=AMQQCNT-1

 +1        IF '$DATA(AMQQTXEX)

               SET ^UTILITY("AMQQ TAX",$JOB,AMQQURGN,AMQQDFN)=""

 +2       IF '$TEST

               KILL ^UTILITY("AMQQ TAX",$JOB,AMQQURGN,AMQQDFN)

 +3        IF AMQQCNT

               QUIT 

A11        SET AMQQCNT=IOSL-4

 +1        READ !,"<>",AMQQR:DTIME

          IF '$TEST

               SET AMQQR=U

 +2        IF AMQQR=U

               SET AMQQTJMP=""

               WRITE !,"OK"

               QUIT 

 +3        IF AMQQR["?"

               WRITE " Enter ""^"" to stop display, return to continue"

               GOTO A11

 +4        QUIT 

 +5       ;

RANGES    ; ENTRY POINT FROM AMQQTXG1 ; DISPLAY TABLE OF ALL RANGES

 +1        IF $DATA(AMQQXX)

               QUIT 

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        IF '$DATA(AMQQNECO)

               WRITE !!,"Code Range(s) Selected So Far =>",!

 +4        SET (AMQQ("NUM"),AMQQ)=0

 +5        FOR 

               SET AMQQ=$ORDER(@AMQQHILO@(AMQQ))

               IF AMQQ=""

                   QUIT 

               SET AMQQ("NUM")=AMQQ("NUM")+1

               WRITE !,AMQQ("NUM"),")  ",AMQQ,$SELECT(AMQQ'=$PIECE(@AMQQHILO@(AMQQ),U,1):"- "_$PIECE(@AMQQHILO@(AMQQ),U,1),1:"")

               IF $PIECE(@AMQQHILO@(AMQQ),U,3)

                   WRITE $PIECE(^ICDS($PIECE(@AMQQHILO@(AMQQ),U,3),0),U,1)

 +6        IF '$DATA(AMQQ("BANG"))

               WRITE !

 +7        QUIT 

 +8       ;

SHOW      ; ENTRY POINT FROM AMQQTXG1 ; ALLOW USER TO SELECT FROM RANGES TO DISPLAY CODES

 +1        DO RANGES

 +2        IF AMQQ("NUM")=1

               SET X=1

               GOTO AA

A          WRITE !,"Enter an Item Number from the table above to display code(s): "

 +1        READ X:DTIME

          IF '$TEST

               SET X=U

 +2        IF X?1."?"

               WRITE !!,"Enter a number between 1 and ",AMQQ("NUM"),!

               GOTO A

 +3        IF X=U

               QUIT 

 +4        IF X

               IF X'>AMQQ("NUM")

                   IF X?1N

 +5       IF '$TEST

               WRITE "  ??",*7

               GOTO A

AA         SET AMQQ("N")=X

 +1        FOR AMQQI=1:AMQQ("N")

               SET AMQQ=$ORDER(@AMQQHILO@(AMQQ))

               IF AMQQI=AMQQ("N")

                   SET AMQQ("LOW")=AMQQ

                   SET AMQQ("HI")=@AMQQHILO@(AMQQ)

                   DO DISPLAY

                   QUIT 

 +2        SET AMQQ("BANG")=""

 +3        DO RANGES

 +4        KILL AMQQ("BANG")

 +5        QUIT 

 +6       ;

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

 +1        IF '$DATA(@AMQQHILO)

               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"

 +3        SET %=1

 +4        DO YN^DICN

 +5        IF %=1

               DO SHOW

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

               QUIT 

 +7        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

 +8        QUIT 

 +9       ;