PXRMPTTX ; SLC/PKR - Routines for taxonomy print templates ;05/07/2014
;;2.0;CLINICAL REMINDERS;**12,26**;Feb 04, 2005;Build 404
;References to ICDAPIU DBIA #3991.
;References to ICPTAPIU DBIA #1997.
;References to ICDCODE DBIA #3990.
;References to ICPTCOD DBIA #1995.
;=======================================================
CHKEXP ;Check the expansion
I '$D(^PXD(811.3,D0)) W !!,"Expansion check; expansion does not exist." Q
N CODE,EXPOK,EXTRA,FNUM,LMAX,LOW,HIGH,HMAX,LIST,NEWLINE,NEXTRA,NMISS
N OEXTRA,PTR,TLEN,TYPE
;Store 811.3 expansion in EXTRA, "current" one is in ^TMP
I $D(^PXD(811.3,D0,80,"ICD9P")) M EXTRA("ICD 9")=^PXD(811.3,D0,80,"ICD9P")
I $D(^PXD(811.3,D0,80.1,"ICD0P")) M EXTRA("ICD 0")=^PXD(811.3,D0,80.1,"ICD0P")
I $D(^PXD(811.3,D0,81,"ICPTP")) M EXTRA("CPT")=^PXD(811.3,D0,81,"ICPTP")
S EXPOK=1
W !!,"Expansion check; expansion was last built on ",$$FMTE^XLFDT($P(^PXD(811.3,D0,0),U,2),"5Z")
F FNUM=80,80.1,81 D
. S TYPE=$S(FNUM=80:"ICD 9",FNUM=80.1:"ICD 0",FNUM=81:"CPT",1:"")
. K LIST
. S PTR=""
. F S PTR=$O(^TMP($J,"TAXEXP",FNUM,PTR)) Q:PTR="" D
.. I $D(EXTRA(TYPE,PTR)) K EXTRA(TYPE,PTR),^TMP($J,"TAXEXP",FNUM,PTR)
. I $D(^TMP($J,"TAXEXP",FNUM)) D
.. S (HMAX,LMAX)=0
.. S PTR=""
.. F S PTR=$O(^TMP($J,"TAXEXP",FNUM,PTR)) Q:PTR="" D
... S CODE=""
... F S CODE=$O(^TMP($J,"TAXEXP",FNUM,PTR,CODE)) Q:CODE="" D
.... S LOW=""
.... F S LOW=$O(^TMP($J,"TAXEXP",FNUM,PTR,CODE,LOW)) Q:LOW="" D
..... S TLEN=$L(LOW)
..... I TLEN>LMAX S LMAX=TLEN
..... S HIGH=""
..... F S HIGH=$O(^TMP($J,"TAXEXP",FNUM,PTR,CODE,LOW,HIGH)) Q:HIGH="" D
...... S TLEN=$L(HIGH)
...... I TLEN>HMAX S HMAX=TLEN
...... S LIST(CODE_" ",PTR,LOW,HIGH)=""
. K ^TMP($J,"TAXEXP",FNUM)
. I $D(LIST) D
.. W !!,"The following ",TYPE," codes are missing from the expansion:"
.. W !,?5,"Code",?14,"Range"
.. S (EXPOK,NMISS)=0
.. S CODE=""
.. F S CODE=$O(LIST(CODE)) Q:CODE="" D
... S NMISS=NMISS+1
... W !,$$RJ^XLFSTR(NMISS,4)," ",$$LJ^XLFSTR(CODE,8)
... S PTR=""
... F S PTR=$O(LIST(CODE,PTR)) Q:PTR="" D
.... S LOW="",NEWLINE=-1
.... F S LOW=$O(LIST(CODE,PTR,LOW)) Q:LOW="" D
..... S HIGH=""
..... F S HIGH=$O(LIST(CODE,PTR,LOW,HIGH)) Q:HIGH="" D
...... S NEWLINE=NEWLINE+1
...... I NEWLINE=0 W ?14,$$LJ^XLFSTR(LOW,LMAX),"-",$$LJ^XLFSTR(HIGH,HMAX)," "," (IEN="_PTR_")"
...... I NEWLINE>0 W !,?14,$$LJ^XLFSTR(LOW,LMAX),"-",$$LJ^XLFSTR(HIGH,HMAX)
. I $D(EXTRA(TYPE)) D
.. S EXPOK=0,NEXTRA=0
.. W !!,"The following ",TYPE," codes are in the expansion and they should not be:"
.. K OEXTRA
.. S PTR=""
.. F S PTR=$O(EXTRA(TYPE,PTR)) Q:PTR="" D
... S CODE=$S(FNUM=81:$$CPT^ICPTCOD(PTR,DT),FNUM=80:$$ICDDX^ICDCODE(PTR,DT),FNUM=80.1:$$ICDOP^ICDCODE(PTR,DT))
... S OEXTRA($P(CODE,U,2)_" ")=$P(CODE,U,4)_" (IEN="_PTR_")"
.. S CODE=""
.. F S CODE=$O(OEXTRA(CODE)) Q:CODE="" D
... S NEXTRA=NEXTRA+1
... W !,$$RJ^XLFSTR(NEXTRA,4)," ",CODE,?10,OEXTRA(CODE)
I EXPOK W !,"The expansion is correct."
Q
;
;=======================================================
ICD0LIST ;Print expanded list of ICD0 codes.
N ACTDATE,CODE,DATA,IEN,INADATE,LOW,HIGH,PTR,TEMP,TEXT
S TEMP=^PXD(811.2,D0,80.1,D1,0)
S (ACTDATE,INADATE)=$$FMTE^XLFDT(DT,"5Z")
S LOW=$P(TEMP,U,1)
S HIGH=$P(TEMP,U,2)
I HIGH="" S HIGH=LOW
W !!,?2,"Code",?10,"ICD Operation/Procedure",?42,"Activation",?54,"Inactivation"
W !,?2,"----",?10,"-----------------------",?42,"----------",?54,"------------"
S CODE=LOW
F Q:(CODE]HIGH)!(CODE="") D
. K DATA
. D PERIOD^ICDAPIU(CODE,.DATA)
. S ACTDATE=0
. F S ACTDATE=$O(DATA(ACTDATE)) Q:ACTDATE="" D
.. S INADATE=$P(DATA(ACTDATE),U,1)
.. S TEXT=$P(DATA(ACTDATE),U,2)
.. S TEXT=$E(TEXT,1,30)
.. W !,?2,CODE,?10,TEXT,?42,$$FMTE^XLFDT(ACTDATE,"5Z"),?54,$$FMTE^XLFDT(INADATE,"5Z")
. S IEN=$P($$STATCHK^ICDAPIU(CODE,""),U,2)
. S ^TMP($J,"TAXEXP",80.1,IEN,CODE,LOW,HIGH)=""
. S CODE=$$NEXT^ICDAPIU(CODE)
Q
;
;=======================================================
ICD9LIST ;Print expanded list of ICD9 codes.
N ACTDATE,CODE,DATA,IEN,INADATE,LOW,HIGH,PTR,SEL,TEMP,TEXT
S TEMP=^PXD(811.2,D0,80,D1,0)
S LOW=$P(TEMP,U,1)
S HIGH=$P(TEMP,U,2)
I HIGH="" S HIGH=LOW
W !!,?2,"Code",?10,"ICD Diagnosis",?42,"Activation",?54,"Inactivation",?67,"Selectable"
W !,?2,"----",?10,"--------------",?42,"----------",?54,"------------",?67,"----------"
S CODE=LOW
F Q:(CODE]HIGH)!(CODE="") D
. K DATA
. D PERIOD^ICDAPIU(CODE,.DATA)
. S IEN=$P(DATA(0),U,1)
. S SEL=$S($D(^PXD(811.2,D0,"SDX","B",IEN)):"X",1:"")
. S ACTDATE=0
. F S ACTDATE=$O(DATA(ACTDATE)) Q:ACTDATE="" D
.. S INADATE=$P(DATA(ACTDATE),U,1)
.. S TEXT=$P(DATA(ACTDATE),U,2)
.. W !,?2,CODE,?10,TEXT,?42,$$FMTE^XLFDT(ACTDATE,"5Z"),?54,$$FMTE^XLFDT(INADATE,"5Z"),?71,SEL
. S PTR=$P($$STATCHK^ICDAPIU(CODE,""),U,2)
. S ^TMP($J,"TAXEXP",80,PTR,CODE,LOW,HIGH)=""
. S CODE=$$NEXT^ICDAPIU(CODE)
Q
;
;=======================================================
ICPTLIST ;Print expanded list of CPT codes.
N ACTDATE,CODE,DATA,IEN,INADATE,LOW,HIGH,PTR,SEL,TEMP,TEXT
S TEMP=^PXD(811.2,D0,81,D1,0)
S LOW=$P(TEMP,U,1)
S HIGH=$P(TEMP,U,2)
I HIGH="" S HIGH=LOW
W !!,?2,"Code",?10,"CPT Short Name",?42,"Activation",?54,"Inactivation",?67,"Selectable"
W !,?2,"----",?10,"--------------",?42,"----------",?54,"------------",?67,"----------"
S CODE=LOW
F Q:(CODE]HIGH)!(CODE="") D
. K DATA
. D PERIOD^ICPTAPIU(CODE,.DATA)
. S IEN=$P(DATA(0),U,1)
. S SEL=$S($D(^PXD(811.2,D0,"SPR","B",IEN)):"X",1:"")
. S ACTDATE=0
. F S ACTDATE=$O(DATA(ACTDATE)) Q:ACTDATE="" D
.. S INADATE=$P(DATA(ACTDATE),U,1)
.. S TEXT=$P(DATA(ACTDATE),U,2)
.. W !,?2,CODE,?10,TEXT,?42,$$FMTE^XLFDT(ACTDATE,"5Z"),?54,$$FMTE^XLFDT(INADATE,"5Z"),?71,SEL
. S PTR=$P($$STATCHK^ICPTAPIU(CODE,""),U,2)
. S ^TMP($J,"TAXEXP",81,PTR,CODE,LOW,HIGH)=""
. S CODE=$$NEXT^ICPTAPIU(CODE)
Q
;
;=======================================================
TAXLIST ;Taxonomy list.
N CODES,CPT,CPTLIST,IC,ICD0,ICD0LIST,ICD9,ICD9LIST,IND,NCODES
S (IC,IND)=0
F S IND=+$O(^PXD(811.2,D0,80,IND)) Q:IND=0 D
. S IC=IC+1
. S CODES=^PXD(811.2,D0,80,IND,0)
. S ICD9LIST(IC)=CODES
S NCODES=IC
;
S (IC,IND)=0
F S IND=+$O(^PXD(811.2,D0,80.1,IND)) Q:IND=0 D
. S IC=IC+1
. S CODES=^PXD(811.2,D0,80.1,IND,0)
. S ICD0LIST(IC)=CODES
S NCODES=$$MAX^XLFMTH(NCODES,IC)
;
S (IC,IND)=0
F S IND=+$O(^PXD(811.2,D0,81,IND)) Q:IND=0 D
. S IC=IC+1
. S CODES=^PXD(811.2,D0,81,IND,0)
. S CPTLIST(IC)=CODES
S NCODES=$$MAX^XLFMTH(NCODES,IC)
;Print the list.
F IC=1:1:NCODES D
. S ICD9=$G(ICD9LIST(IC))
. S ICD0=$G(ICD0LIST(IC))
. S CPT=$G(CPTLIST(IC))
. W !,?9,$P(ICD9,U,1),?19,$P(ICD9,U,2)
. W ?29,$P(ICD0,U,1),?39,$P(ICD0,U,2)
. W ?49,$P(CPT,U,1),?59,$P(CPT,U,2)
Q
;
PXRMPTTX ; SLC/PKR - Routines for taxonomy print templates ;05/07/2014
+1 ;;2.0;CLINICAL REMINDERS;**12,26**;Feb 04, 2005;Build 404
+2 ;References to ICDAPIU DBIA #3991.
+3 ;References to ICPTAPIU DBIA #1997.
+4 ;References to ICDCODE DBIA #3990.
+5 ;References to ICPTCOD DBIA #1995.
+6 ;=======================================================
CHKEXP ;Check the expansion
+1 IF '$DATA(^PXD(811.3,D0))
WRITE !!,"Expansion check; expansion does not exist."
QUIT
+2 NEW CODE,EXPOK,EXTRA,FNUM,LMAX,LOW,HIGH,HMAX,LIST,NEWLINE,NEXTRA,NMISS
+3 NEW OEXTRA,PTR,TLEN,TYPE
+4 ;Store 811.3 expansion in EXTRA, "current" one is in ^TMP
+5 IF $DATA(^PXD(811.3,D0,80,"ICD9P"))
MERGE EXTRA("ICD 9")=^PXD(811.3,D0,80,"ICD9P")
+6 IF $DATA(^PXD(811.3,D0,80.1,"ICD0P"))
MERGE EXTRA("ICD 0")=^PXD(811.3,D0,80.1,"ICD0P")
+7 IF $DATA(^PXD(811.3,D0,81,"ICPTP"))
MERGE EXTRA("CPT")=^PXD(811.3,D0,81,"ICPTP")
+8 SET EXPOK=1
+9 WRITE !!,"Expansion check; expansion was last built on ",$$FMTE^XLFDT($PIECE(^PXD(811.3,D0,0),U,2),"5Z")
+10 FOR FNUM=80,80.1,81
Begin DoDot:1
+11 SET TYPE=$SELECT(FNUM=80:"ICD 9",FNUM=80.1:"ICD 0",FNUM=81:"CPT",1:"")
+12 KILL LIST
+13 SET PTR=""
+14 FOR
SET PTR=$ORDER(^TMP($JOB,"TAXEXP",FNUM,PTR))
IF PTR=""
QUIT
Begin DoDot:2
+15 IF $DATA(EXTRA(TYPE,PTR))
KILL EXTRA(TYPE,PTR),^TMP($JOB,"TAXEXP",FNUM,PTR)
End DoDot:2
+16 IF $DATA(^TMP($JOB,"TAXEXP",FNUM))
Begin DoDot:2
+17 SET (HMAX,LMAX)=0
+18 SET PTR=""
+19 FOR
SET PTR=$ORDER(^TMP($JOB,"TAXEXP",FNUM,PTR))
IF PTR=""
QUIT
Begin DoDot:3
+20 SET CODE=""
+21 FOR
SET CODE=$ORDER(^TMP($JOB,"TAXEXP",FNUM,PTR,CODE))
IF CODE=""
QUIT
Begin DoDot:4
+22 SET LOW=""
+23 FOR
SET LOW=$ORDER(^TMP($JOB,"TAXEXP",FNUM,PTR,CODE,LOW))
IF LOW=""
QUIT
Begin DoDot:5
+24 SET TLEN=$LENGTH(LOW)
+25 IF TLEN>LMAX
SET LMAX=TLEN
+26 SET HIGH=""
+27 FOR
SET HIGH=$ORDER(^TMP($JOB,"TAXEXP",FNUM,PTR,CODE,LOW,HIGH))
IF HIGH=""
QUIT
Begin DoDot:6
+28 SET TLEN=$LENGTH(HIGH)
+29 IF TLEN>HMAX
SET HMAX=TLEN
+30 SET LIST(CODE_" ",PTR,LOW,HIGH)=""
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+31 KILL ^TMP($JOB,"TAXEXP",FNUM)
+32 IF $DATA(LIST)
Begin DoDot:2
+33 WRITE !!,"The following ",TYPE," codes are missing from the expansion:"
+34 WRITE !,?5,"Code",?14,"Range"
+35 SET (EXPOK,NMISS)=0
+36 SET CODE=""
+37 FOR
SET CODE=$ORDER(LIST(CODE))
IF CODE=""
QUIT
Begin DoDot:3
+38 SET NMISS=NMISS+1
+39 WRITE !,$$RJ^XLFSTR(NMISS,4)," ",$$LJ^XLFSTR(CODE,8)
+40 SET PTR=""
+41 FOR
SET PTR=$ORDER(LIST(CODE,PTR))
IF PTR=""
QUIT
Begin DoDot:4
+42 SET LOW=""
SET NEWLINE=-1
+43 FOR
SET LOW=$ORDER(LIST(CODE,PTR,LOW))
IF LOW=""
QUIT
Begin DoDot:5
+44 SET HIGH=""
+45 FOR
SET HIGH=$ORDER(LIST(CODE,PTR,LOW,HIGH))
IF HIGH=""
QUIT
Begin DoDot:6
+46 SET NEWLINE=NEWLINE+1
+47 IF NEWLINE=0
WRITE ?14,$$LJ^XLFSTR(LOW,LMAX),"-",$$LJ^XLFSTR(HIGH,HMAX)," "," (IEN="_PTR_")"
+48 IF NEWLINE>0
WRITE !,?14,$$LJ^XLFSTR(LOW,LMAX),"-",$$LJ^XLFSTR(HIGH,HMAX)
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+49 IF $DATA(EXTRA(TYPE))
Begin DoDot:2
+50 SET EXPOK=0
SET NEXTRA=0
+51 WRITE !!,"The following ",TYPE," codes are in the expansion and they should not be:"
+52 KILL OEXTRA
+53 SET PTR=""
+54 FOR
SET PTR=$ORDER(EXTRA(TYPE,PTR))
IF PTR=""
QUIT
Begin DoDot:3
+55 SET CODE=$SELECT(FNUM=81:$$CPT^ICPTCOD(PTR,DT),FNUM=80:$$ICDDX^ICDCODE(PTR,DT),FNUM=80.1:$$ICDOP^ICDCODE(PTR,DT))
+56 SET OEXTRA($PIECE(CODE,U,2)_" ")=$PIECE(CODE,U,4)_" (IEN="_PTR_")"
End DoDot:3
+57 SET CODE=""
+58 FOR
SET CODE=$ORDER(OEXTRA(CODE))
IF CODE=""
QUIT
Begin DoDot:3
+59 SET NEXTRA=NEXTRA+1
+60 WRITE !,$$RJ^XLFSTR(NEXTRA,4)," ",CODE,?10,OEXTRA(CODE)
End DoDot:3
End DoDot:2
End DoDot:1
+61 IF EXPOK
WRITE !,"The expansion is correct."
+62 QUIT
+63 ;
+64 ;=======================================================
ICD0LIST ;Print expanded list of ICD0 codes.
+1 NEW ACTDATE,CODE,DATA,IEN,INADATE,LOW,HIGH,PTR,TEMP,TEXT
+2 SET TEMP=^PXD(811.2,D0,80.1,D1,0)
+3 SET (ACTDATE,INADATE)=$$FMTE^XLFDT(DT,"5Z")
+4 SET LOW=$PIECE(TEMP,U,1)
+5 SET HIGH=$PIECE(TEMP,U,2)
+6 IF HIGH=""
SET HIGH=LOW
+7 WRITE !!,?2,"Code",?10,"ICD Operation/Procedure",?42,"Activation",?54,"Inactivation"
+8 WRITE !,?2,"----",?10,"-----------------------",?42,"----------",?54,"------------"
+9 SET CODE=LOW
+10 FOR
IF (CODE]HIGH)!(CODE="")
QUIT
Begin DoDot:1
+11 KILL DATA
+12 DO PERIOD^ICDAPIU(CODE,.DATA)
+13 SET ACTDATE=0
+14 FOR
SET ACTDATE=$ORDER(DATA(ACTDATE))
IF ACTDATE=""
QUIT
Begin DoDot:2
+15 SET INADATE=$PIECE(DATA(ACTDATE),U,1)
+16 SET TEXT=$PIECE(DATA(ACTDATE),U,2)
+17 SET TEXT=$EXTRACT(TEXT,1,30)
+18 WRITE !,?2,CODE,?10,TEXT,?42,$$FMTE^XLFDT(ACTDATE,"5Z"),?54,$$FMTE^XLFDT(INADATE,"5Z")
End DoDot:2
+19 SET IEN=$PIECE($$STATCHK^ICDAPIU(CODE,""),U,2)
+20 SET ^TMP($JOB,"TAXEXP",80.1,IEN,CODE,LOW,HIGH)=""
+21 SET CODE=$$NEXT^ICDAPIU(CODE)
End DoDot:1
+22 QUIT
+23 ;
+24 ;=======================================================
ICD9LIST ;Print expanded list of ICD9 codes.
+1 NEW ACTDATE,CODE,DATA,IEN,INADATE,LOW,HIGH,PTR,SEL,TEMP,TEXT
+2 SET TEMP=^PXD(811.2,D0,80,D1,0)
+3 SET LOW=$PIECE(TEMP,U,1)
+4 SET HIGH=$PIECE(TEMP,U,2)
+5 IF HIGH=""
SET HIGH=LOW
+6 WRITE !!,?2,"Code",?10,"ICD Diagnosis",?42,"Activation",?54,"Inactivation",?67,"Selectable"
+7 WRITE !,?2,"----",?10,"--------------",?42,"----------",?54,"------------",?67,"----------"
+8 SET CODE=LOW
+9 FOR
IF (CODE]HIGH)!(CODE="")
QUIT
Begin DoDot:1
+10 KILL DATA
+11 DO PERIOD^ICDAPIU(CODE,.DATA)
+12 SET IEN=$PIECE(DATA(0),U,1)
+13 SET SEL=$SELECT($DATA(^PXD(811.2,D0,"SDX","B",IEN)):"X",1:"")
+14 SET ACTDATE=0
+15 FOR
SET ACTDATE=$ORDER(DATA(ACTDATE))
IF ACTDATE=""
QUIT
Begin DoDot:2
+16 SET INADATE=$PIECE(DATA(ACTDATE),U,1)
+17 SET TEXT=$PIECE(DATA(ACTDATE),U,2)
+18 WRITE !,?2,CODE,?10,TEXT,?42,$$FMTE^XLFDT(ACTDATE,"5Z"),?54,$$FMTE^XLFDT(INADATE,"5Z"),?71,SEL
End DoDot:2
+19 SET PTR=$PIECE($$STATCHK^ICDAPIU(CODE,""),U,2)
+20 SET ^TMP($JOB,"TAXEXP",80,PTR,CODE,LOW,HIGH)=""
+21 SET CODE=$$NEXT^ICDAPIU(CODE)
End DoDot:1
+22 QUIT
+23 ;
+24 ;=======================================================
ICPTLIST ;Print expanded list of CPT codes.
+1 NEW ACTDATE,CODE,DATA,IEN,INADATE,LOW,HIGH,PTR,SEL,TEMP,TEXT
+2 SET TEMP=^PXD(811.2,D0,81,D1,0)
+3 SET LOW=$PIECE(TEMP,U,1)
+4 SET HIGH=$PIECE(TEMP,U,2)
+5 IF HIGH=""
SET HIGH=LOW
+6 WRITE !!,?2,"Code",?10,"CPT Short Name",?42,"Activation",?54,"Inactivation",?67,"Selectable"
+7 WRITE !,?2,"----",?10,"--------------",?42,"----------",?54,"------------",?67,"----------"
+8 SET CODE=LOW
+9 FOR
IF (CODE]HIGH)!(CODE="")
QUIT
Begin DoDot:1
+10 KILL DATA
+11 DO PERIOD^ICPTAPIU(CODE,.DATA)
+12 SET IEN=$PIECE(DATA(0),U,1)
+13 SET SEL=$SELECT($DATA(^PXD(811.2,D0,"SPR","B",IEN)):"X",1:"")
+14 SET ACTDATE=0
+15 FOR
SET ACTDATE=$ORDER(DATA(ACTDATE))
IF ACTDATE=""
QUIT
Begin DoDot:2
+16 SET INADATE=$PIECE(DATA(ACTDATE),U,1)
+17 SET TEXT=$PIECE(DATA(ACTDATE),U,2)
+18 WRITE !,?2,CODE,?10,TEXT,?42,$$FMTE^XLFDT(ACTDATE,"5Z"),?54,$$FMTE^XLFDT(INADATE,"5Z"),?71,SEL
End DoDot:2
+19 SET PTR=$PIECE($$STATCHK^ICPTAPIU(CODE,""),U,2)
+20 SET ^TMP($JOB,"TAXEXP",81,PTR,CODE,LOW,HIGH)=""
+21 SET CODE=$$NEXT^ICPTAPIU(CODE)
End DoDot:1
+22 QUIT
+23 ;
+24 ;=======================================================
TAXLIST ;Taxonomy list.
+1 NEW CODES,CPT,CPTLIST,IC,ICD0,ICD0LIST,ICD9,ICD9LIST,IND,NCODES
+2 SET (IC,IND)=0
+3 FOR
SET IND=+$ORDER(^PXD(811.2,D0,80,IND))
IF IND=0
QUIT
Begin DoDot:1
+4 SET IC=IC+1
+5 SET CODES=^PXD(811.2,D0,80,IND,0)
+6 SET ICD9LIST(IC)=CODES
End DoDot:1
+7 SET NCODES=IC
+8 ;
+9 SET (IC,IND)=0
+10 FOR
SET IND=+$ORDER(^PXD(811.2,D0,80.1,IND))
IF IND=0
QUIT
Begin DoDot:1
+11 SET IC=IC+1
+12 SET CODES=^PXD(811.2,D0,80.1,IND,0)
+13 SET ICD0LIST(IC)=CODES
End DoDot:1
+14 SET NCODES=$$MAX^XLFMTH(NCODES,IC)
+15 ;
+16 SET (IC,IND)=0
+17 FOR
SET IND=+$ORDER(^PXD(811.2,D0,81,IND))
IF IND=0
QUIT
Begin DoDot:1
+18 SET IC=IC+1
+19 SET CODES=^PXD(811.2,D0,81,IND,0)
+20 SET CPTLIST(IC)=CODES
End DoDot:1
+21 SET NCODES=$$MAX^XLFMTH(NCODES,IC)
+22 ;Print the list.
+23 FOR IC=1:1:NCODES
Begin DoDot:1
+24 SET ICD9=$GET(ICD9LIST(IC))
+25 SET ICD0=$GET(ICD0LIST(IC))
+26 SET CPT=$GET(CPTLIST(IC))
+27 WRITE !,?9,$PIECE(ICD9,U,1),?19,$PIECE(ICD9,U,2)
+28 WRITE ?29,$PIECE(ICD0,U,1),?39,$PIECE(ICD0,U,2)
+29 WRITE ?49,$PIECE(CPT,U,1),?59,$PIECE(CPT,U,2)
End DoDot:1
+30 QUIT
+31 ;
