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

PXRMPTTX.m

Go to the documentation of this file. 
  1. PXRMPTTX ; SLC/PKR - Routines for taxonomy print templates ;05/07/2014
  1.  ;;2.0;CLINICAL REMINDERS;**12,26**;Feb 04, 2005;Build 404
  1.  ;References to ICDAPIU DBIA #3991.
  1.  ;References to ICPTAPIU DBIA #1997.
  1.  ;References to ICDCODE DBIA #3990.
  1.  ;References to ICPTCOD DBIA #1995.
  1.  ;=======================================================
  1. CHKEXP ;Check the expansion
  1.  I '$D(^PXD(811.3,D0)) W !!,"Expansion check; expansion does not exist." Q
  1.  N CODE,EXPOK,EXTRA,FNUM,LMAX,LOW,HIGH,HMAX,LIST,NEWLINE,NEXTRA,NMISS
  1.  N OEXTRA,PTR,TLEN,TYPE
  1.  ;Store 811.3 expansion in EXTRA, "current" one is in ^TMP
  1.  I $D(^PXD(811.3,D0,80,"ICD9P")) M EXTRA("ICD 9")=^PXD(811.3,D0,80,"ICD9P")
  1.  I $D(^PXD(811.3,D0,80.1,"ICD0P")) M EXTRA("ICD 0")=^PXD(811.3,D0,80.1,"ICD0P")
  1.  I $D(^PXD(811.3,D0,81,"ICPTP")) M EXTRA("CPT")=^PXD(811.3,D0,81,"ICPTP")
  1.  S EXPOK=1
  1.  W !!,"Expansion check; expansion was last built on ",$$FMTE^XLFDT($P(^PXD(811.3,D0,0),U,2),"5Z")
  1.  F FNUM=80,80.1,81 D
  1.  . S TYPE=$S(FNUM=80:"ICD 9",FNUM=80.1:"ICD 0",FNUM=81:"CPT",1:"")
  1.  . K LIST
  1.  . S PTR=""
  1.  . F  S PTR=$O(^TMP($J,"TAXEXP",FNUM,PTR)) Q:PTR=""  D
  1.  .. I $D(EXTRA(TYPE,PTR)) K EXTRA(TYPE,PTR),^TMP($J,"TAXEXP",FNUM,PTR)
  1.  . I $D(^TMP($J,"TAXEXP",FNUM)) D
  1.  .. S (HMAX,LMAX)=0
  1.  .. S PTR=""
  1.  .. F  S PTR=$O(^TMP($J,"TAXEXP",FNUM,PTR)) Q:PTR=""  D
  1.  ... S CODE=""
  1.  ... F  S CODE=$O(^TMP($J,"TAXEXP",FNUM,PTR,CODE)) Q:CODE=""  D
  1.  .... S LOW=""
  1.  .... F  S LOW=$O(^TMP($J,"TAXEXP",FNUM,PTR,CODE,LOW)) Q:LOW=""  D
  1.  ..... S TLEN=$L(LOW)
  1.  ..... I TLEN>LMAX S LMAX=TLEN
  1.  ..... S HIGH=""
  1.  ..... F  S HIGH=$O(^TMP($J,"TAXEXP",FNUM,PTR,CODE,LOW,HIGH)) Q:HIGH=""  D
  1.  ...... S TLEN=$L(HIGH)
  1.  ...... I TLEN>HMAX S HMAX=TLEN
  1.  ...... S LIST(CODE_" ",PTR,LOW,HIGH)=""
  1.  . K ^TMP($J,"TAXEXP",FNUM)
  1.  . I $D(LIST) D
  1.  .. W !!,"The following ",TYPE," codes are missing from the expansion:"
  1.  .. W !,?5,"Code",?14,"Range"
  1.  .. S (EXPOK,NMISS)=0
  1.  .. S CODE=""
  1.  .. F  S CODE=$O(LIST(CODE)) Q:CODE=""  D
  1.  ... S NMISS=NMISS+1
  1.  ... W !,$$RJ^XLFSTR(NMISS,4)," ",$$LJ^XLFSTR(CODE,8)
  1.  ... S PTR=""
  1.  ... F  S PTR=$O(LIST(CODE,PTR)) Q:PTR=""  D
  1.  .... S LOW="",NEWLINE=-1
  1.  .... F  S LOW=$O(LIST(CODE,PTR,LOW)) Q:LOW=""  D
  1.  ..... S HIGH=""
  1.  ..... F  S HIGH=$O(LIST(CODE,PTR,LOW,HIGH)) Q:HIGH=""  D
  1.  ...... S NEWLINE=NEWLINE+1
  1.  ...... I NEWLINE=0 W ?14,$$LJ^XLFSTR(LOW,LMAX),"-",$$LJ^XLFSTR(HIGH,HMAX),"  "," (IEN="_PTR_")"
  1.  ...... I NEWLINE>0 W !,?14,$$LJ^XLFSTR(LOW,LMAX),"-",$$LJ^XLFSTR(HIGH,HMAX)
  1.  . I $D(EXTRA(TYPE)) D
  1.  .. S EXPOK=0,NEXTRA=0
  1.  .. W !!,"The following ",TYPE," codes are in the expansion and they should not be:"
  1.  .. K OEXTRA
  1.  .. S PTR=""
  1.  .. F  S PTR=$O(EXTRA(TYPE,PTR)) Q:PTR=""  D
  1.  ... S CODE=$S(FNUM=81:$$CPT^ICPTCOD(PTR,DT),FNUM=80:$$ICDDX^ICDCODE(PTR,DT),FNUM=80.1:$$ICDOP^ICDCODE(PTR,DT))
  1.  ... S OEXTRA($P(CODE,U,2)_" ")=$P(CODE,U,4)_" (IEN="_PTR_")"
  1.  .. S CODE=""
  1.  .. F  S CODE=$O(OEXTRA(CODE)) Q:CODE=""  D
  1.  ... S NEXTRA=NEXTRA+1
  1.  ... W !,$$RJ^XLFSTR(NEXTRA,4),"  ",CODE,?10,OEXTRA(CODE)
  1.  I EXPOK W !,"The expansion is correct."
  1.  Q
  1.  ;
  1.  ;=======================================================
  1. ICD0LIST ;Print expanded list of ICD0 codes.
  1.  N ACTDATE,CODE,DATA,IEN,INADATE,LOW,HIGH,PTR,TEMP,TEXT
  1.  S TEMP=^PXD(811.2,D0,80.1,D1,0)
  1.  S (ACTDATE,INADATE)=$$FMTE^XLFDT(DT,"5Z")
  1.  S LOW=$P(TEMP,U,1)
  1.  S HIGH=$P(TEMP,U,2)
  1.  I HIGH="" S HIGH=LOW
  1.  W !!,?2,"Code",?10,"ICD Operation/Procedure",?42,"Activation",?54,"Inactivation"
  1.  W !,?2,"----",?10,"-----------------------",?42,"----------",?54,"------------"
  1.  S CODE=LOW
  1.  F  Q:(CODE]HIGH)!(CODE="")  D
  1.  . K DATA
  1.  . D PERIOD^ICDAPIU(CODE,.DATA)
  1.  . S ACTDATE=0
  1.  . F  S ACTDATE=$O(DATA(ACTDATE)) Q:ACTDATE=""  D
  1.  .. S INADATE=$P(DATA(ACTDATE),U,1)
  1.  .. S TEXT=$P(DATA(ACTDATE),U,2)
  1.  .. S TEXT=$E(TEXT,1,30)
  1.  .. W !,?2,CODE,?10,TEXT,?42,$$FMTE^XLFDT(ACTDATE,"5Z"),?54,$$FMTE^XLFDT(INADATE,"5Z")
  1.  . S IEN=$P($$STATCHK^ICDAPIU(CODE,""),U,2)
  1.  . S ^TMP($J,"TAXEXP",80.1,IEN,CODE,LOW,HIGH)=""
  1.  . S CODE=$$NEXT^ICDAPIU(CODE)
  1.  Q
  1.  ;
  1.  ;=======================================================
  1. ICD9LIST ;Print expanded list of ICD9 codes.
  1.  N ACTDATE,CODE,DATA,IEN,INADATE,LOW,HIGH,PTR,SEL,TEMP,TEXT
  1.  S TEMP=^PXD(811.2,D0,80,D1,0)
  1.  S LOW=$P(TEMP,U,1)
  1.  S HIGH=$P(TEMP,U,2)
  1.  I HIGH="" S HIGH=LOW
  1.  W !!,?2,"Code",?10,"ICD Diagnosis",?42,"Activation",?54,"Inactivation",?67,"Selectable"
  1.  W !,?2,"----",?10,"--------------",?42,"----------",?54,"------------",?67,"----------"
  1.  S CODE=LOW
  1.  F  Q:(CODE]HIGH)!(CODE="")  D
  1.  . K DATA
  1.  . D PERIOD^ICDAPIU(CODE,.DATA)
  1.  . S IEN=$P(DATA(0),U,1)
  1.  . S SEL=$S($D(^PXD(811.2,D0,"SDX","B",IEN)):"X",1:"")
  1.  . S ACTDATE=0
  1.  . F  S ACTDATE=$O(DATA(ACTDATE)) Q:ACTDATE=""  D
  1.  .. S INADATE=$P(DATA(ACTDATE),U,1)
  1.  .. S TEXT=$P(DATA(ACTDATE),U,2)
  1.  .. W !,?2,CODE,?10,TEXT,?42,$$FMTE^XLFDT(ACTDATE,"5Z"),?54,$$FMTE^XLFDT(INADATE,"5Z"),?71,SEL
  1.  . S PTR=$P($$STATCHK^ICDAPIU(CODE,""),U,2)
  1.  . S ^TMP($J,"TAXEXP",80,PTR,CODE,LOW,HIGH)=""
  1.  . S CODE=$$NEXT^ICDAPIU(CODE)
  1.  Q
  1.  ;
  1.  ;=======================================================
  1. ICPTLIST ;Print expanded list of CPT codes.
  1.  N ACTDATE,CODE,DATA,IEN,INADATE,LOW,HIGH,PTR,SEL,TEMP,TEXT
  1.  S TEMP=^PXD(811.2,D0,81,D1,0)
  1.  S LOW=$P(TEMP,U,1)
  1.  S HIGH=$P(TEMP,U,2)
  1.  I HIGH="" S HIGH=LOW
  1.  W !!,?2,"Code",?10,"CPT Short Name",?42,"Activation",?54,"Inactivation",?67,"Selectable"
  1.  W !,?2,"----",?10,"--------------",?42,"----------",?54,"------------",?67,"----------"
  1.  S CODE=LOW
  1.  F  Q:(CODE]HIGH)!(CODE="")  D
  1.  . K DATA
  1.  . D PERIOD^ICPTAPIU(CODE,.DATA)
  1.  . S IEN=$P(DATA(0),U,1)
  1.  . S SEL=$S($D(^PXD(811.2,D0,"SPR","B",IEN)):"X",1:"")
  1.  . S ACTDATE=0
  1.  . F  S ACTDATE=$O(DATA(ACTDATE)) Q:ACTDATE=""  D
  1.  .. S INADATE=$P(DATA(ACTDATE),U,1)
  1.  .. S TEXT=$P(DATA(ACTDATE),U,2)
  1.  .. W !,?2,CODE,?10,TEXT,?42,$$FMTE^XLFDT(ACTDATE,"5Z"),?54,$$FMTE^XLFDT(INADATE,"5Z"),?71,SEL
  1.  . S PTR=$P($$STATCHK^ICPTAPIU(CODE,""),U,2)
  1.  . S ^TMP($J,"TAXEXP",81,PTR,CODE,LOW,HIGH)=""
  1.  . S CODE=$$NEXT^ICPTAPIU(CODE)
  1.  Q
  1.  ;
  1.  ;=======================================================
  1. TAXLIST ;Taxonomy list.
  1.  N CODES,CPT,CPTLIST,IC,ICD0,ICD0LIST,ICD9,ICD9LIST,IND,NCODES
  1.  S (IC,IND)=0
  1.  F  S IND=+$O(^PXD(811.2,D0,80,IND)) Q:IND=0  D
  1.  . S IC=IC+1
  1.  . S CODES=^PXD(811.2,D0,80,IND,0)
  1.  . S ICD9LIST(IC)=CODES
  1.  S NCODES=IC
  1.  ;
  1.  S (IC,IND)=0
  1.  F  S IND=+$O(^PXD(811.2,D0,80.1,IND)) Q:IND=0  D
  1.  . S IC=IC+1
  1.  . S CODES=^PXD(811.2,D0,80.1,IND,0)
  1.  . S ICD0LIST(IC)=CODES
  1.  S NCODES=$$MAX^XLFMTH(NCODES,IC)
  1.  ;
  1.  S (IC,IND)=0
  1.  F  S IND=+$O(^PXD(811.2,D0,81,IND)) Q:IND=0  D
  1.  . S IC=IC+1
  1.  . S CODES=^PXD(811.2,D0,81,IND,0)
  1.  . S CPTLIST(IC)=CODES
  1.  S NCODES=$$MAX^XLFMTH(NCODES,IC)
  1.  ;Print the list.
  1.  F IC=1:1:NCODES D
  1.  . S ICD9=$G(ICD9LIST(IC))
  1.  . S ICD0=$G(ICD0LIST(IC))
  1.  . S CPT=$G(CPTLIST(IC))
  1.  . W !,?9,$P(ICD9,U,1),?19,$P(ICD9,U,2)
  1.  . W ?29,$P(ICD0,U,1),?39,$P(ICD0,U,2)
  1.  . W ?49,$P(CPT,U,1),?59,$P(CPT,U,2)
  1.  Q
  1.  ;