PXRMCSSC ; SLC/PKR - Routines for taxonomy code set update. ;04/10/2003
;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
;
;============================================================
SELCODE(FILENUM,TAXIEN,LC,TAXMSG) ;Create the message for selectable
;codes. Check for codes that are currently inactive or will be
;inactive within the next 180 days.
N CODE,CPTCLST,CPTFLST,DT6M,ICD9CLST,ICD9FLST,IEN,ILC,MSGARR,NODE,STATUS
;Go through the selectable codes making an ordered list.
I FILENUM'=80,FILENUM'=81 Q
S DT6M=$$DT6M^PXRMCSU(DT)
S ILC=0
I FILENUM=80 D
. S IEN=0
. F S IEN=$O(^PXD(811.2,TAXIEN,"SDX","B",IEN)) Q:IEN="" D
.. S CODE=$$CODEC^ICDCODE(IEN)
.. S STATUS=+$$STATCHK^ICDAPIU(CODE,DT)
.. I 'STATUS S ICD9CLST(CODE_" ")=CODE
.. I STATUS D
... S STATUS=+$$STATCHK^ICDAPIU(CODE,DT6M)
... I 'STATUS S ICD9FLST(CODE_" ")=CODE
I FILENUM=81 D
. S IEN=0
. F S IEN=$O(^PXD(811.2,TAXIEN,"SPR","B",IEN)) Q:IEN="" D
.. S CODE=$$CODEC^ICPTCOD(IEN)
.. S STATUS=+$$STATCHK^ICPTAPIU(CODE,DT)
.. I 'STATUS S CPTCLST(CODE_" ")=CODE
I $D(ICD9CLST) D
. S IEN=""
. F S IEN=$O(ICD9CLST(IEN)) Q:IEN="" D
.. S CODE=ICD9CLST(IEN),ILC=ILC+1
.. S MSGARR(ILC)="Selectable ICD9 code "_CODE_" is inactive."
I $D(ICD9FLST) D
. S IEN=""
. F S IEN=$O(ICD9FLST(IEN)) Q:IEN="" D
.. S CODE=ICD9FLST(IEN),ILC=ILC+1
.. S MSGARR(ILC)="Selectable ICD9 code "_CODE_" will be inactive within 180 days."
I $D(CPTCLST) D
. S IEN=""
. F S IEN=$O(CPTCLST(IEN)) Q:IEN="" D
.. S CODE=CPTCLST(IEN),ILC=ILC+1
.. S MSGARR(ILC)="Selectable CPT code "_CODE_" is inactive."
I $D(CPTFLST) D
. S IEN=""
. F S IEN=$O(CPTFLST(IEN)) Q:IEN="" D
.. S CODE=CPTFLST(IEN),ILC=ILC+1
.. S MSGARR(ILC)="Selectable CPT code "_CODE_" will be inactive with 180 days."
I ILC>0 D
. S ILC=ILC+1,MSGARR(ILC)=" ",TAXMSG=1
. D ADDTMSG^PXRMCSTX(.LC,.MSGARR)
Q
;
PXRMCSSC ; SLC/PKR - Routines for taxonomy code set update. ;04/10/2003
+1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+2 ;
+3 ;============================================================
SELCODE(FILENUM,TAXIEN,LC,TAXMSG) ;Create the message for selectable
+1 ;codes. Check for codes that are currently inactive or will be
+2 ;inactive within the next 180 days.
+3 NEW CODE,CPTCLST,CPTFLST,DT6M,ICD9CLST,ICD9FLST,IEN,ILC,MSGARR,NODE,STATUS
+4 ;Go through the selectable codes making an ordered list.
+5 IF FILENUM'=80
IF FILENUM'=81
QUIT
+6 SET DT6M=$$DT6M^PXRMCSU(DT)
+7 SET ILC=0
+8 IF FILENUM=80
Begin DoDot:1
+9 SET IEN=0
+10 FOR
SET IEN=$ORDER(^PXD(811.2,TAXIEN,"SDX","B",IEN))
IF IEN=""
QUIT
Begin DoDot:2
+11 SET CODE=$$CODEC^ICDCODE(IEN)
+12 SET STATUS=+$$STATCHK^ICDAPIU(CODE,DT)
+13 IF 'STATUS
SET ICD9CLST(CODE_" ")=CODE
+14 IF STATUS
Begin DoDot:3
+15 SET STATUS=+$$STATCHK^ICDAPIU(CODE,DT6M)
+16 IF 'STATUS
SET ICD9FLST(CODE_" ")=CODE
End DoDot:3
End DoDot:2
End DoDot:1
+17 IF FILENUM=81
Begin DoDot:1
+18 SET IEN=0
+19 FOR
SET IEN=$ORDER(^PXD(811.2,TAXIEN,"SPR","B",IEN))
IF IEN=""
QUIT
Begin DoDot:2
+20 SET CODE=$$CODEC^ICPTCOD(IEN)
+21 SET STATUS=+$$STATCHK^ICPTAPIU(CODE,DT)
+22 IF 'STATUS
SET CPTCLST(CODE_" ")=CODE
End DoDot:2
End DoDot:1
+23 IF $DATA(ICD9CLST)
Begin DoDot:1
+24 SET IEN=""
+25 FOR
SET IEN=$ORDER(ICD9CLST(IEN))
IF IEN=""
QUIT
Begin DoDot:2
+26 SET CODE=ICD9CLST(IEN)
SET ILC=ILC+1
+27 SET MSGARR(ILC)="Selectable ICD9 code "_CODE_" is inactive."
End DoDot:2
End DoDot:1
+28 IF $DATA(ICD9FLST)
Begin DoDot:1
+29 SET IEN=""
+30 FOR
SET IEN=$ORDER(ICD9FLST(IEN))
IF IEN=""
QUIT
Begin DoDot:2
+31 SET CODE=ICD9FLST(IEN)
SET ILC=ILC+1
+32 SET MSGARR(ILC)="Selectable ICD9 code "_CODE_" will be inactive within 180 days."
End DoDot:2
End DoDot:1
+33 IF $DATA(CPTCLST)
Begin DoDot:1
+34 SET IEN=""
+35 FOR
SET IEN=$ORDER(CPTCLST(IEN))
IF IEN=""
QUIT
Begin DoDot:2
+36 SET CODE=CPTCLST(IEN)
SET ILC=ILC+1
+37 SET MSGARR(ILC)="Selectable CPT code "_CODE_" is inactive."
End DoDot:2
End DoDot:1
+38 IF $DATA(CPTFLST)
Begin DoDot:1
+39 SET IEN=""
+40 FOR
SET IEN=$ORDER(CPTFLST(IEN))
IF IEN=""
QUIT
Begin DoDot:2
+41 SET CODE=CPTFLST(IEN)
SET ILC=ILC+1
+42 SET MSGARR(ILC)="Selectable CPT code "_CODE_" will be inactive with 180 days."
End DoDot:2
End DoDot:1
+43 IF ILC>0
Begin DoDot:1
+44 SET ILC=ILC+1
SET MSGARR(ILC)=" "
SET TAXMSG=1
+45 DO ADDTMSG^PXRMCSTX(.LC,.MSGARR)
End DoDot:1
+46 QUIT
+47 ;
