AMQQTXG ; IHS/CMI/THL - POINTER TAXONOMY ;
;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
;-----
EN3 ; ENTRY POINT FOR POINTER TAXONOMY
S AMQQHELP="PHELP"
S AMQQHEL1="PHELP1"
S AMQQLKUP="PLOOKUP"
VAR ;
S AMQQTAXI=$P(^AMQQ(5,AMQQATN,0),U,17)
RUN D GET
I '$D(AMQQQUIT),'$D(AMQQSCMP),AMQQTAXT'=2,'$D(AMQQXX) D LIST^AMQQTX
EXIT K X,AMQQTAXI,I,AMQQTGFG,AMQQTDIC,AMQQHELP,AMQQHEL1,AMQQLKUP,AMQQXXN,%,%Y,N,T,C
Q
;
GET I '$D(AMQQXX) W !
GETR ;
K AMQQISYS,ICDSYS
I $D(AMQQXXTT),$D(AMQQXXN) S AMQQXXN=$O(^UTILITY("AMQQ",$J,"XXTAX",AMQQXXTT,AMQQXXN)) Q:'AMQQXXN S X=^(AMQQXXN) G GRR
I $D(AMQQNTAX),AMQQNTAX="" Q
I $D(AMQQNTAX) S X=AMQQNTAX,AMQQNTAX="" G GRR
I $D(AMQQXX),$D(AMQQONE) S X="ALL" G GRR
;I AMQQTGBL="^ICD9"!(AMQQTGBL="^ICD0") K AMQQNDB D ICDGET G GRR ;X RETURNED AS INPUT VALUE
S %="Enter "_$S($D(^UTILITY("AMQQ TAX",$J,AMQQURGN)):"ANOTHER ",1:"")_AMQQTNAR
K AMQQNDB
W !,%,": "
R X:DTIME E S X=U
GRR ;
I X="",'$D(^UTILITY("AMQQ TAX",$J,AMQQURGN)),'$D(AMQQSCMP) D ACA^AMQQAC Q:X=4 I X="" W ! G GETR
I X="" Q
I X=U S AMQQQUIT="" Q
I X="]" S AMQQTTOT=9 K AMQQTGFG G GETR
I X="@" S X="NULL" W " (NULL SET)"
I X="EXIST" S X="EXISTS" W "S"
I X="ALL",AMQQATN[681 S X="*"
I '$D(AMQQSCMP),$D(AMQQSQNM),$D(AMQQSQSJ),AMQQSQNM'=AMQQSQSJ,AMQQSQNM'="RESULT/DIAGNOSIS" F %="ALL","ANY","EXISTS" I X=% W " ??" G GET
I '$D(AMQQSCMP) F %="ALL","ANY","EXISTS","NULL" I X=% G GEXIT
I X="*" D EDALL G GETR
I X?1"?" D @(AMQQHELP_"^AMQQTXG1") G GETR
I X?2"?" D LIST^AMQQTX G GETR
I X?3."?" D @(AMQQHEL1_"^AMQQTXG1") G GETR
I $E(X)="-",'$D(^UTILITY("AMQQ TAX",$J,AMQQURGN)) W " ??",*7 G GETR
I AMQQTAXT=2,$L(X,"-")>2 D DASH I Y W " ??",*7 G GETR
I $E(X)="-" S X=$E(X,2,99) S AMQQTXEX=""
I $E(X,1,2)="[?" D WHATG^AMQQTX G GETR
I $E(X)="[" D RESTORE^AMQQTX0 G GETR
I $E(X)="""",$E(X,$L(X))="""" S X=$E(X,2,($L(X)-1)),AMQQNDB=""
I X="[" W " ??",*7 G GETR
D @(AMQQLKUP_"^AMQQTXG1")
I $D(AMQQQUIT) Q
I Y'=-1,AMQQTAXT'=2 D SET^AMQQTX
I Y=-1,$D(AMQQXX) K ^UTILITY("AMQQ TAX",$J,AMQQURGN),AMQQTAX Q
I $G(^UTILITY("AMQQ TAX",$J,AMQQURGN))="REFUSAL" Q
G GETR
;
GEXIT I X'="NULL" K ^UTILITY("AMQQ TAX",$J,AMQQURGN) S AMQQSCMP=X Q
D:$D(AMQQCNAM) NULL^AMQQTX
I $D(AMQQQUIT) Q
I $D(AMQQSCMP),AMQQSCMP="NULL" Q
I "Yy"'[$E($G(%Y)) W " ??",*7
G GETR
;
EDALL S %=$P(^AMQQ(1,AMQQLINK,0),U,5)
S %=$P(^AMQQ(4,%,0),U)
I %="G" D EDA Q
I AMQQTLOK="^ICD9("!(AMQQTLOK="^ICD0(") D Q
.D ICDCS
.I AMQQISYS="" W !!,"Coding system must be selected." Q
.NEW AMQQTEMP
.D LST^ATXAPI(AMQQISYS,$S(AMQQTLOK="^ICD9(":80,1:80.1),"*","CODE","AMQQTEMP")
.S %="" F S %=$O(AMQQTEMP(%)) Q:%="" S Y=$P(AMQQTEMP(%),U,1) I Y'="" S ^UTILITY("AMQQ TAX",$J,AMQQURGN,Y)="" W "."
S X=AMQQTLOK_"""B"")"
S %=""
F S %=$O(@X@(%)) Q:%="" S Y=$O(^(%,"")) I Y'="" S ^UTILITY("AMQQ TAX",$J,AMQQURGN,Y)="" W "."
Q
;
EDA N I,%
F I=2:1 S %=$P(AMQQSSET,";",I),%=$P(%,":") Q:%="" S ^UTILITY("AMQQ TAX",$J,AMQQURGN,%)="" W "."
Q
;
DASH S Y=0
I $L(X,"-")>3 S Y=1 Q
I $P(X,"-")'="" S Y=1 Q
F %=2,3 I $P(X,"-",%)="" S Y=1 Q
Q
;
EN5 ; ENTRY POINT FOR HYBRID TAX
D EN3
Q
;
EN1 ; ENTRY POINT FOR FREE TEXT TAX
S (AMQQHELP,AMQQHEL1)="FHELP"
S AMQQLKUP="FLOOKUP"
D VAR
Q
;
EN4 ; ENTRY POINT FOR GROUP OF CODES TAXONOMY
S AMQQHEL1="GHELP1"
S AMQQHELP="PHELP"
S AMQQLKUP="GLOOKUP"
D VAR
Q
;
EN2 ; ENTY POINT FOR RANGE OF CODES
S AMQQHELP="RHELP"
S AMQQLKUP="RLOOKUP"
S AMQQHEL1="RHELP1"
D VAR
Q
;
ICDGET ;
NEW DIC,Y,ICDSYS
;WHAT CODING SYSTEM?
S AMQQSYS=""
W ! ;,"You must enter the coding system to which the codes belong.",!
S DIC("A")="Select the ICD CODING SYSTEM (ICD-9 or ICD-10): ",DIC="^ICDS(",DIC("S")="I $P(^(0),U,3)=80",DIC(0)="AEMQ" D ^DIC K DIC
I $D(DUOUT) S X=U Q
I Y=-1 S X="" Q
S AMQQISYS=+Y
NEW DIR
S DIR("A")="Enter "_$S($D(^UTILITY("AMQQ TAX",$J,AMQQURGN)):"ANOTHER ",1:"")_AMQQTNAR D SETDIR,^DIR K DIR
I "^"[Y S X="" Q
Q
ICDCS ;EP
NEW DIC,Y,ICDSYS
;WHAT CODING SYSTEM?
S AMQQISYS=""
W ! ;,"You must enter the coding system from which these codes belong.",!
S DIC("A")="Select the ICD CODING SYSTEM (ICD-9 or ICD-10): ",DIC="^ICDS(",DIC("S")="I $P(^(0),U,3)="_$S(AMQQTGBL="^ICD9":80,1:80.1)_"",DIC(0)="AEMQ" D ^DIC K DIC
I $D(DUOUT) S X=U Q
I Y=-1 S X="" Q
S AMQQISYS=+Y
Q
SETDIR ; ENTRY POINT - SETS HELP AND DIR FOR INIT SUBROUTINE OF APCDFQA3
S DIR(0)="FO",DIR("?",1)="Enter ICD 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. "
S DIR("?",5)="To select all codes in a set you can use a '*' wildcard. E.g. E11*, 250*"
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')"
Q
AMQQTXG ; IHS/CMI/THL - POINTER TAXONOMY ;
+1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
+2 ;-----
EN3 ; ENTRY POINT FOR POINTER TAXONOMY
+1 SET AMQQHELP="PHELP"
+2 SET AMQQHEL1="PHELP1"
+3 SET AMQQLKUP="PLOOKUP"
VAR ;
+1 SET AMQQTAXI=$PIECE(^AMQQ(5,AMQQATN,0),U,17)
RUN DO GET
+1 IF '$DATA(AMQQQUIT)
IF '$DATA(AMQQSCMP)
IF AMQQTAXT'=2
IF '$DATA(AMQQXX)
DO LIST^AMQQTX
EXIT KILL X,AMQQTAXI,I,AMQQTGFG,AMQQTDIC,AMQQHELP,AMQQHEL1,AMQQLKUP,AMQQXXN,%,%Y,N,T,C
+1 QUIT
+2 ;
GET IF '$DATA(AMQQXX)
WRITE !
GETR ;
+1 KILL AMQQISYS,ICDSYS
+2 IF $DATA(AMQQXXTT)
IF $DATA(AMQQXXN)
SET AMQQXXN=$ORDER(^UTILITY("AMQQ",$JOB,"XXTAX",AMQQXXTT,AMQQXXN))
IF 'AMQQXXN
QUIT
SET X=^(AMQQXXN)
GOTO GRR
+3 IF $DATA(AMQQNTAX)
IF AMQQNTAX=""
QUIT
+4 IF $DATA(AMQQNTAX)
SET X=AMQQNTAX
SET AMQQNTAX=""
GOTO GRR
+5 IF $DATA(AMQQXX)
IF $DATA(AMQQONE)
SET X="ALL"
GOTO GRR
+6 ;I AMQQTGBL="^ICD9"!(AMQQTGBL="^ICD0") K AMQQNDB D ICDGET G GRR ;X RETURNED AS INPUT VALUE
+7 SET %="Enter "_$SELECT($DATA(^UTILITY("AMQQ TAX",$JOB,AMQQURGN)):"ANOTHER ",1:"")_AMQQTNAR
+8 KILL AMQQNDB
+9 WRITE !,%,": "
+10 READ X:DTIME
IF '$TEST
SET X=U
GRR ;
+1 IF X=""
IF '$DATA(^UTILITY("AMQQ TAX",$JOB,AMQQURGN))
IF '$DATA(AMQQSCMP)
DO ACA^AMQQAC
IF X=4
QUIT
IF X=""
WRITE !
GOTO GETR
+2 IF X=""
QUIT
+3 IF X=U
SET AMQQQUIT=""
QUIT
+4 IF X="]"
SET AMQQTTOT=9
KILL AMQQTGFG
GOTO GETR
+5 IF X="@"
SET X="NULL"
WRITE " (NULL SET)"
+6 IF X="EXIST"
SET X="EXISTS"
WRITE "S"
+7 IF X="ALL"
IF AMQQATN[681
SET X="*"
+8 IF '$DATA(AMQQSCMP)
IF $DATA(AMQQSQNM)
IF $DATA(AMQQSQSJ)
IF AMQQSQNM'=AMQQSQSJ
IF AMQQSQNM'="RESULT/DIAGNOSIS"
FOR %="ALL","ANY","EXISTS"
IF X=%
WRITE " ??"
GOTO GET
+9 IF '$DATA(AMQQSCMP)
FOR %="ALL","ANY","EXISTS","NULL"
IF X=%
GOTO GEXIT
+10 IF X="*"
DO EDALL
GOTO GETR
+11 IF X?1"?"
DO @(AMQQHELP_"^AMQQTXG1")
GOTO GETR
+12 IF X?2"?"
DO LIST^AMQQTX
GOTO GETR
+13 IF X?3."?"
DO @(AMQQHEL1_"^AMQQTXG1")
GOTO GETR
+14 IF $EXTRACT(X)="-"
IF '$DATA(^UTILITY("AMQQ TAX",$JOB,AMQQURGN))
WRITE " ??",*7
GOTO GETR
+15 IF AMQQTAXT=2
IF $LENGTH(X,"-")>2
DO DASH
IF Y
WRITE " ??",*7
GOTO GETR
+16 IF $EXTRACT(X)="-"
SET X=$EXTRACT(X,2,99)
SET AMQQTXEX=""
+17 IF $EXTRACT(X,1,2)="[?"
DO WHATG^AMQQTX
GOTO GETR
+18 IF $EXTRACT(X)="["
DO RESTORE^AMQQTX0
GOTO GETR
+19 IF $EXTRACT(X)=""""
IF $EXTRACT(X,$LENGTH(X))=""""
SET X=$EXTRACT(X,2,($LENGTH(X)-1))
SET AMQQNDB=""
+20 IF X="["
WRITE " ??",*7
GOTO GETR
+21 DO @(AMQQLKUP_"^AMQQTXG1")
+22 IF $DATA(AMQQQUIT)
QUIT
+23 IF Y'=-1
IF AMQQTAXT'=2
DO SET^AMQQTX
+24 IF Y=-1
IF $DATA(AMQQXX)
KILL ^UTILITY("AMQQ TAX",$JOB,AMQQURGN),AMQQTAX
QUIT
+25 IF $GET(^UTILITY("AMQQ TAX",$JOB,AMQQURGN))="REFUSAL"
QUIT
+26 GOTO GETR
+27 ;
GEXIT IF X'="NULL"
KILL ^UTILITY("AMQQ TAX",$JOB,AMQQURGN)
SET AMQQSCMP=X
QUIT
+1 IF $DATA(AMQQCNAM)
DO NULL^AMQQTX
+2 IF $DATA(AMQQQUIT)
QUIT
+3 IF $DATA(AMQQSCMP)
IF AMQQSCMP="NULL"
QUIT
+4 IF "Yy"'[$EXTRACT($GET(%Y))
WRITE " ??",*7
+5 GOTO GETR
+6 ;
EDALL SET %=$PIECE(^AMQQ(1,AMQQLINK,0),U,5)
+1 SET %=$PIECE(^AMQQ(4,%,0),U)
+2 IF %="G"
DO EDA
QUIT
+3 IF AMQQTLOK="^ICD9("!(AMQQTLOK="^ICD0(")
Begin DoDot:1
+4 DO ICDCS
+5 IF AMQQISYS=""
WRITE !!,"Coding system must be selected."
QUIT
+6 NEW AMQQTEMP
+7 DO LST^ATXAPI(AMQQISYS,$SELECT(AMQQTLOK="^ICD9(":80,1:80.1),"*","CODE","AMQQTEMP")
+8 SET %=""
FOR
SET %=$ORDER(AMQQTEMP(%))
IF %=""
QUIT
SET Y=$PIECE(AMQQTEMP(%),U,1)
IF Y'=""
SET ^UTILITY("AMQQ TAX",$JOB,AMQQURGN,Y)=""
WRITE "."
End DoDot:1
QUIT
+9 SET X=AMQQTLOK_"""B"")"
+10 SET %=""
+11 FOR
SET %=$ORDER(@X@(%))
IF %=""
QUIT
SET Y=$ORDER(^(%,""))
IF Y'=""
SET ^UTILITY("AMQQ TAX",$JOB,AMQQURGN,Y)=""
WRITE "."
+12 QUIT
+13 ;
EDA NEW I,%
+1 FOR I=2:1
SET %=$PIECE(AMQQSSET,";",I)
SET %=$PIECE(%,":")
IF %=""
QUIT
SET ^UTILITY("AMQQ TAX",$JOB,AMQQURGN,%)=""
WRITE "."
+2 QUIT
+3 ;
DASH SET Y=0
+1 IF $LENGTH(X,"-")>3
SET Y=1
QUIT
+2 IF $PIECE(X,"-")'=""
SET Y=1
QUIT
+3 FOR %=2,3
IF $PIECE(X,"-",%)=""
SET Y=1
QUIT
+4 QUIT
+5 ;
EN5 ; ENTRY POINT FOR HYBRID TAX
+1 DO EN3
+2 QUIT
+3 ;
EN1 ; ENTRY POINT FOR FREE TEXT TAX
+1 SET (AMQQHELP,AMQQHEL1)="FHELP"
+2 SET AMQQLKUP="FLOOKUP"
+3 DO VAR
+4 QUIT
+5 ;
EN4 ; ENTRY POINT FOR GROUP OF CODES TAXONOMY
+1 SET AMQQHEL1="GHELP1"
+2 SET AMQQHELP="PHELP"
+3 SET AMQQLKUP="GLOOKUP"
+4 DO VAR
+5 QUIT
+6 ;
EN2 ; ENTY POINT FOR RANGE OF CODES
+1 SET AMQQHELP="RHELP"
+2 SET AMQQLKUP="RLOOKUP"
+3 SET AMQQHEL1="RHELP1"
+4 DO VAR
+5 QUIT
+6 ;
ICDGET ;
+1 NEW DIC,Y,ICDSYS
+2 ;WHAT CODING SYSTEM?
+3 SET AMQQSYS=""
+4 ;,"You must enter the coding system to which the codes belong.",!
WRITE !
+5 SET DIC("A")="Select the ICD CODING SYSTEM (ICD-9 or ICD-10): "
SET DIC="^ICDS("
SET DIC("S")="I $P(^(0),U,3)=80"
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+6 IF $DATA(DUOUT)
SET X=U
QUIT
+7 IF Y=-1
SET X=""
QUIT
+8 SET AMQQISYS=+Y
+9 NEW DIR
+10 SET DIR("A")="Enter "_$SELECT($DATA(^UTILITY("AMQQ TAX",$JOB,AMQQURGN)):"ANOTHER ",1:"")_AMQQTNAR
DO SETDIR
DO ^DIR
KILL DIR
+11 IF "^"[Y
SET X=""
QUIT
+12 QUIT
ICDCS ;EP
+1 NEW DIC,Y,ICDSYS
+2 ;WHAT CODING SYSTEM?
+3 SET AMQQISYS=""
+4 ;,"You must enter the coding system from which these codes belong.",!
WRITE !
+5 SET DIC("A")="Select the ICD CODING SYSTEM (ICD-9 or ICD-10): "
SET DIC="^ICDS("
SET DIC("S")="I $P(^(0),U,3)="_$SELECT(AMQQTGBL="^ICD9":80,1:80.1)_""
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+6 IF $DATA(DUOUT)
SET X=U
QUIT
+7 IF Y=-1
SET X=""
QUIT
+8 SET AMQQISYS=+Y
+9 QUIT
SETDIR ; ENTRY POINT - SETS HELP AND DIR FOR INIT SUBROUTINE OF APCDFQA3
+1 SET DIR(0)="FO"
SET DIR("?",1)="Enter ICD diagnosis code or narrative. You may enter a range of"
SET DIR("?",2)="codes by placing a ""-"" between two codes. Codes in a range will"
+2 SET DIR("?",3)="include the first and last codes indicated and all codes that fall"
SET DIR("?",4)="between. Only one code or one range of codes at a time. "
+3 SET DIR("?",5)="To select all codes in a set you can use a '*' wildcard. E.g. E11*, 250*"
+4 SET DIR("?",6)="You can also ""de-select"" a code or range of codes by placing a ""-"" in"
SET DIR("?",7)="front of it. (e.g. '-250.00' or '-250.01-250.91')"
+5 QUIT
