Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMQQTXG

AMQQTXG.m

Go to the documentation of this file. 
  1. AMQQTXG ; IHS/CMI/THL - POINTER TAXONOMY ;
  1.  ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
  1.  ;-----
  1. EN3 ; ENTRY POINT FOR POINTER TAXONOMY
  1.  S AMQQHELP="PHELP"
  1.  S AMQQHEL1="PHELP1"
  1.  S AMQQLKUP="PLOOKUP"
  1. VAR ;
  1.  S AMQQTAXI=$P(^AMQQ(5,AMQQATN,0),U,17)
  1. RUN D GET
  1.  I '$D(AMQQQUIT),'$D(AMQQSCMP),AMQQTAXT'=2,'$D(AMQQXX) D LIST^AMQQTX
  1. EXIT K X,AMQQTAXI,I,AMQQTGFG,AMQQTDIC,AMQQHELP,AMQQHEL1,AMQQLKUP,AMQQXXN,%,%Y,N,T,C
  1.  Q
  1.  ;
  1. GET I '$D(AMQQXX) W !
  1. GETR ;
  1.  K AMQQISYS,ICDSYS
  1.  I $D(AMQQXXTT),$D(AMQQXXN) S AMQQXXN=$O(^UTILITY("AMQQ",$J,"XXTAX",AMQQXXTT,AMQQXXN)) Q:'AMQQXXN  S X=^(AMQQXXN) G GRR
  1.  I $D(AMQQNTAX),AMQQNTAX="" Q
  1.  I $D(AMQQNTAX) S X=AMQQNTAX,AMQQNTAX="" G GRR
  1.  I $D(AMQQXX),$D(AMQQONE) S X="ALL" G GRR
  1.  ;I AMQQTGBL="^ICD9"!(AMQQTGBL="^ICD0") K AMQQNDB D ICDGET G GRR  ;X RETURNED AS INPUT VALUE
  1.  S %="Enter "_$S($D(^UTILITY("AMQQ TAX",$J,AMQQURGN)):"ANOTHER ",1:"")_AMQQTNAR
  1.  K AMQQNDB
  1.  W !,%,": "
  1.  R X:DTIME E  S X=U
  1. GRR ;
  1.  I X="",'$D(^UTILITY("AMQQ TAX",$J,AMQQURGN)),'$D(AMQQSCMP) D ACA^AMQQAC Q:X=4  I X="" W ! G GETR
  1.  I X="" Q
  1.  I X=U S AMQQQUIT="" Q
  1.  I X="]" S AMQQTTOT=9 K AMQQTGFG G GETR
  1.  I X="@" S X="NULL" W " (NULL SET)"
  1.  I X="EXIST" S X="EXISTS" W "S"
  1.  I X="ALL",AMQQATN[681 S X="*"
  1.  I '$D(AMQQSCMP),$D(AMQQSQNM),$D(AMQQSQSJ),AMQQSQNM'=AMQQSQSJ,AMQQSQNM'="RESULT/DIAGNOSIS" F %="ALL","ANY","EXISTS" I X=% W " ??" G GET
  1.  I '$D(AMQQSCMP) F %="ALL","ANY","EXISTS","NULL" I X=% G GEXIT
  1.  I X="*" D EDALL G GETR
  1.  I X?1"?" D @(AMQQHELP_"^AMQQTXG1") G GETR
  1.  I X?2"?" D LIST^AMQQTX G GETR
  1.  I X?3."?" D @(AMQQHEL1_"^AMQQTXG1") G GETR
  1.  I $E(X)="-",'$D(^UTILITY("AMQQ TAX",$J,AMQQURGN)) W "  ??",*7 G GETR
  1.  I AMQQTAXT=2,$L(X,"-")>2 D DASH I Y W "  ??",*7 G GETR
  1.  I $E(X)="-" S X=$E(X,2,99) S AMQQTXEX=""
  1.  I $E(X,1,2)="[?" D WHATG^AMQQTX G GETR
  1.  I $E(X)="[" D RESTORE^AMQQTX0 G GETR
  1.  I $E(X)="""",$E(X,$L(X))="""" S X=$E(X,2,($L(X)-1)),AMQQNDB=""
  1.  I X="[" W "  ??",*7 G GETR
  1.  D @(AMQQLKUP_"^AMQQTXG1")
  1.  I $D(AMQQQUIT) Q
  1.  I Y'=-1,AMQQTAXT'=2 D SET^AMQQTX
  1.  I Y=-1,$D(AMQQXX) K ^UTILITY("AMQQ TAX",$J,AMQQURGN),AMQQTAX Q
  1.  I $G(^UTILITY("AMQQ TAX",$J,AMQQURGN))="REFUSAL" Q
  1.  G GETR
  1.  ;
  1. GEXIT I X'="NULL" K ^UTILITY("AMQQ TAX",$J,AMQQURGN) S AMQQSCMP=X Q
  1.  D:$D(AMQQCNAM) NULL^AMQQTX
  1.  I $D(AMQQQUIT) Q
  1.  I $D(AMQQSCMP),AMQQSCMP="NULL" Q
  1.  I "Yy"'[$E($G(%Y)) W " ??",*7
  1.  G GETR
  1.  ;
  1. EDALL S %=$P(^AMQQ(1,AMQQLINK,0),U,5)
  1.  S %=$P(^AMQQ(4,%,0),U)
  1.  I %="G" D EDA Q
  1.  I AMQQTLOK="^ICD9("!(AMQQTLOK="^ICD0(") D  Q
  1.  .D ICDCS
  1.  .I AMQQISYS="" W !!,"Coding system must be selected." Q
  1.  .NEW AMQQTEMP
  1.  .D LST^ATXAPI(AMQQISYS,$S(AMQQTLOK="^ICD9(":80,1:80.1),"*","CODE","AMQQTEMP")
  1.  .S %="" F  S %=$O(AMQQTEMP(%)) Q:%=""  S Y=$P(AMQQTEMP(%),U,1) I Y'="" S ^UTILITY("AMQQ TAX",$J,AMQQURGN,Y)="" W "."
  1.  S X=AMQQTLOK_"""B"")"
  1.  S %=""
  1.  F  S %=$O(@X@(%)) Q:%=""  S Y=$O(^(%,"")) I Y'="" S ^UTILITY("AMQQ TAX",$J,AMQQURGN,Y)="" W "."
  1.  Q
  1.  ;
  1. EDA N I,%
  1.  F I=2:1 S %=$P(AMQQSSET,";",I),%=$P(%,":") Q:%=""  S ^UTILITY("AMQQ TAX",$J,AMQQURGN,%)="" W "."
  1.  Q
  1.  ;
  1. DASH S Y=0
  1.  I $L(X,"-")>3 S Y=1 Q
  1.  I $P(X,"-")'="" S Y=1 Q
  1.  F %=2,3 I $P(X,"-",%)="" S Y=1 Q
  1.  Q
  1.  ;
  1. EN5 ; ENTRY POINT FOR HYBRID TAX
  1.  D EN3
  1.  Q
  1.  ;
  1. EN1 ; ENTRY POINT FOR FREE TEXT TAX
  1.  S (AMQQHELP,AMQQHEL1)="FHELP"
  1.  S AMQQLKUP="FLOOKUP"
  1.  D VAR
  1.  Q
  1.  ;
  1. EN4 ; ENTRY POINT FOR GROUP OF CODES TAXONOMY
  1.  S AMQQHEL1="GHELP1"
  1.  S AMQQHELP="PHELP"
  1.  S AMQQLKUP="GLOOKUP"
  1.  D VAR
  1.  Q
  1.  ;
  1. EN2 ; ENTY POINT FOR RANGE OF CODES
  1.  S AMQQHELP="RHELP"
  1.  S AMQQLKUP="RLOOKUP"
  1.  S AMQQHEL1="RHELP1"
  1.  D VAR
  1.  Q
  1.  ;
  1. ICDGET ;
  1.  NEW DIC,Y,ICDSYS
  1.  ;WHAT CODING SYSTEM?
  1.  S AMQQSYS=""
  1.  W ! ;,"You must enter the coding system to which the codes belong.",!
  1.  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
  1.  I $D(DUOUT) S X=U Q
  1.  I Y=-1 S X="" Q
  1.  S AMQQISYS=+Y
  1.  NEW DIR
  1.  S DIR("A")="Enter "_$S($D(^UTILITY("AMQQ TAX",$J,AMQQURGN)):"ANOTHER ",1:"")_AMQQTNAR D SETDIR,^DIR K DIR
  1.  I "^"[Y S X="" Q
  1.  Q
  1. ICDCS ;EP
  1.  NEW DIC,Y,ICDSYS
  1.  ;WHAT CODING SYSTEM?
  1.  S AMQQISYS=""
  1.  W ! ;,"You must enter the coding system from which these codes belong.",!
  1.  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
  1.  I $D(DUOUT) S X=U Q
  1.  I Y=-1 S X="" Q
  1.  S AMQQISYS=+Y
  1.  Q
  1. SETDIR ; ENTRY POINT - SETS HELP AND DIR FOR INIT SUBROUTINE OF APCDFQA3
  1.  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"
  1.  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.  "
  1.  S DIR("?",5)="To select all codes in a set you can use a '*' wildcard.  E.g. E11*, 250*"
  1.  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')"
  1.  Q