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 ;
