ICD1831J ; ALB/ECF - FY 2008 UPDATE; 8/27/07 14:50
;;18.0;DRG Grouper;**31**;Oct 13,2000 2:30 pm;Build 7
Q
;
DRG(ICDTMP) ;post-install driver for file ICD Diagnosis file(#80) DRG updates
;This procedure creates and files the MSv25DRG updates
;
; Input:
; ICDTMP - Temp file of error msg's
; ICDTOT - Total MS-DRG codes filed
; Output:
; ICDTMP - Temp file of error msg's
; ICDTOT - Total MS-DRG codes filed
; ICDERTOT - Total error records of type "cannot file"
;
N ICDI,ICDCRCD,ICDNWCD,ICDTOT,ICDETOT,ICDVAL,ICDXX,ICX1,ICDZZ ; This is a rough but growing list of variables
S U="^"
S (ICDI,ICDTOT,ICDETOT)=0
S ICDXX=""
S (ICDINAC,ICDAD)=0
;
;ANNOUNCE PROJECT
;
D BMES^XPDUTL(">>> Adding FY 2008 DRG Grouper updates to ICD Diagnosis file (#80)...")
;
;Set up reference to error log
;
S ICDTMP=$G(ICDTMP)
I ICDTMP']"" S ICDTMP=$NA(^TMP("ICDDGFY2008D",$J)) D
. K @ICDTMP
. S @ICDTMP@(0)="PATCH FY 2008 ICD DIAGNOSIS DRG UPDATE^"_$$NOW^XLFDT
;
;LOOP THROUGH FILE 80 - PROCESS EACH ENTRY
;All except inactive entries may have new DRGs
;
F S ICDI=$O(^ICD9(ICDI)) Q:ICDI=""!(ICDI'?.N) D
.;quit if no zero node
.Q:$G(^ICD9(ICDI,0))=""
.;quit if zero node corrupt
.Q:$P($G(^ICD9(ICDI,0)),U,1)']""
.;quit if code is inactive
.;
.S ICDVAL=$P($G(^ICD9(ICDI,0)),U)
.Q:ICDVAL=""
.;quit if code is inactive
.S ICDZZ=$$ICDDX^ICDCODE(ICDVAL,3071001)
.Q:$P($G(ICDZZ),U,10)=0
.;
.;check if already created in case patch being re-installed
.S:$D(^ICD9(ICDI,3,"B",3071001)) ICDAD=ICDAD+1
.Q:$D(^ICD9(ICDI,3,"B",3071001))
.;
.;Capture latest set of DRG codes (80.07) and latest MDC Effective Date's MDC (80.072)
.;
.S ICDCRCD=$$GETCRCD(ICDI)
.Q:ICDCRCD']""
.;
.;Codes are passed to converter in string ICDCRCD <.01 field>^<MDC ien>^<DRG ien)^<DRG ien>...
.;Function returns one set of codes, format is <.01 field>^<MDC ien>^<DRG ien)^<DRG ien>...
.;If no converion values, then return format is <.01_field>_^_<mdc_ien>
.;
.S ICDNWCD=$$CONV80^ICD1831L(ICDCRCD)
.Q:$P($G(ICDNWCD),U,1)']""
.Q:$P($G(ICDNWCD),U,2)']""
.Q:$P($G(ICDNWCD),U,3)']""
.;pass new codes to update procedure
.;
.D UPDDIAG(ICDI,ICDNWCD,ICDTMP,.ICDTOT)
;
;
;HANDLE ERRORS
;No errors present
;
I '$D(@ICDTMP@("ERROR")) D
. D MES^XPDUTL(">>> ICD PROCEDURE File DRG Updates Completed...")
. D MES^XPDUTL(" ...Total Codes Edited: "_ICDTOT)
. D MES^XPDUTL("")
;Q
;Errors present
;
I $D(@ICDTMP@("ERROR")) D
. F S ICDXX=$O(^TMP("ICDDGFY2008D",$J,ICDXX)) Q:ICDXX="" D
..S ICDETOT=ICDETOT+1
. D MES^XPDUTL(">>> ...Total Errors "_ICDETOT_" ERRORS")
. D MES^XPDUTL("")
. D MES^XPDUTL("Error are in ^TMP(""ICDDGFY2008D"",$J)")
;
K ICDCRCD,ICDVAL,ICDZZ
Q
;
;END OF DRIVER
;
;Start of helper functions and procedures
;
GETCRCD(ICDI) ;
;INPUT ICDI = ien in file 80.1 ICD Diagnosis Codes
;OUTPUT ICCRCDS = string of current DRG Codes for latest DRG Grouper Effective Date
; and the latest MDC (80.072, #1)
;
N ICDLDGED,ICDLMDED,ICDDGD2,ICDDGD3,ICDMDD1,ICDX,ICDCRCDS,ICDMDC
;LAST DRG EFFECTIVE DATE, LAST MDC EFFECTIVE DATE, IEN IN DRG EF DT, IEN IN DRG
;IEN IN MDC EFF DATE, STRING OF RETURN CODES, SCRATCH VARIABLE
;
;RETURN IEN^MDC^DRG^DRG^DRG..... (values are pointers)
;
S (ICDMDC,ICDCRCDS)=""
;
;START STRING WITH THE .01 FIELD OF THE ENTRY (ICDI)
;
S ICDCRCDS=$P(^ICD9(ICDI,0),U,1)
;
;NEXT GET THE MDC ATTACHED TO THE LATEST MDC EFFECTIVE DATE
;
S ICDLMDED=$O(^ICD9(ICDI,4,"B",9999999),-1)
I ICDLMDED]"" D
.S ICDMDD1=$O(^ICD9(ICDI,4,"B",ICDLMDED,0))
.S ICDMDC=$P($G(^ICD9(ICDI,4,ICDMDD1,0)),U,2)
S ICDCRCDS=ICDCRCDS_"^"_$S((ICDMDC)]"":ICDMDC,1:"")
;
;THEN GET THE DRG MULTIPLE CODES
;
S ICDLDGED=$O(^ICD9(ICDI,3,"B",9999999),-1)
Q:ICDLDGED="" ICDCRCDS ; new record - is active but has no DRG entries
S ICDDGD2=$O(^ICD9(ICDI,3,"B",ICDLDGED,0)) ;GET IEN IN DRG MULTIPLE
Q:$G(^ICD9(ICDI,3,ICDDGD2,1,0))']"" "" ;QUIT, SOMETHING IS WRONG
S ICDDGD3=0
F S ICDDGD3=$O(^ICD9(ICDI,3,ICDDGD2,1,ICDDGD3)) Q:ICDDGD3="" D
.S ICDCRCDS=ICDCRCDS_"^"_$G(^ICD9(ICDI,3,ICDDGD2,1,ICDDGD3,0))
Q ICDCRCDS
;
;
UPDDIAG(ICDIP,ICDIAGP,ICDTMPP,ICDTOTP) ;
;Add 80.071 and 80.711 records for DRG Effective Date 10/1/07
;for both new and existing records
;
;Input ICDIP IEN in file 80
; ICDIAGP DRG string from CONV80^ICD1831L function
; format: <.01_field>^<mdc_ien>^<drg1_ien>^<drg2_ien>...
; ICDTMPP Error tracker - ^TMP(""CDDGFY2008D",$J)
; ICDTOT ICD Diagnosis Code File records sucessfully filed
;
;--------------------------------------------------------------------
;
; N ICDZ
; F ICDZ=1:1:3 I $P(ICDIAGP,U,ICDZ)']"" D Q
; .S @ICDTMP@("ERROR",ICDIP,68)="Missing field "_ICDZ_" filing "_ICDIAGP
;
;Add DRG FY08 Multiple
;
K FDA(1831)
S FDA(1831,80,"?1,",.01)="`"_ICDIP
S FDA(1831,80.071,"+2,?1,",.01)=3071001
D UPDATE^DIE("","FDA(1831)")
K FDA(1831)
;
I $P(ICDIAGP,U,3)]"" D
.S FDA(1831,80,"?1,",.01)="`"_ICDIP
.S FDA(1831,80.071,"?2,?1,",.01)=3071001
.S FDA(1831,80.711,"+3,?2,?1,",.01)=$P(ICDIAGP,U,3)
.D UPDATE^DIE("","FDA(1831)")
K FDA(1831)
;
;
I $P(ICDIAGP,U,4)]"" D
.S FDA(1831,80,"?1,",.01)="`"_ICDIP
.S FDA(1831,80.071,"?2,?1,",.01)=3071001
.S FDA(1831,80.711,"+4,?2,?1,",.01)=$P(ICDIAGP,U,4)
.D UPDATE^DIE("","FDA(1831)")
K FDA(1831)
;
I $P(ICDIAGP,U,5)]"" D
.S FDA(1831,80,"?1,",.01)="`"_ICDIP
.S FDA(1831,80.071,"?2,?1,",.01)=3071001
.S FDA(1831,80.711,"+5,?2,?1,",.01)=$P(ICDIAGP,U,5)
.D UPDATE^DIE("","FDA(1831)")
K FDA(1831)
;
I $P(ICDIAGP,U,6)]"" D
.S FDA(1831,80,"?1,",.01)="`"_ICDIP
.S FDA(1831,80.071,"?2,?1,",.01)=3071001
.S FDA(1831,80.711,"+6,?2,?1,",.01)=$P(ICDIAGP,U,6)
.D UPDATE^DIE("","FDA(1831)")
K FDA(1831)
;
I $P(ICDIAGP,U,7)]"" D
.S FDA(1831,80,"?1,",.01)="`"_ICDIP
.S FDA(1831,80.071,"?2,?1,",.01)=3071001
.S FDA(1831,80.711,"+7,?2,?1,",.01)=$P(ICDIAGP,U,7)
.D UPDATE^DIE("","FDA(1831)")
K FDA(1831)
;
;
I $P(ICDIAGP,U,8)]"" D
.S FDA(1831,80,"?1,",.01)="`"_ICDIP
.S FDA(1831,80.071,"?2,?1,",.01)=3071001
.S FDA(1831,80.711,"+8,?2,?1,",.01)=$P(ICDIAGP,U,8)
.D UPDATE^DIE("","FDA(1831)")
K FDA(1831)
;
I $P(ICDIAGP,U,9)]"" D
.S FDA(1831,80,"?1,",.01)="`"_ICDIP
.S FDA(1831,80.071,"?2,?1,",.01)=3071001
.S FDA(1831,80.711,"+9,?2,?1,",.01)=$P(ICDIAGP,U,9)
.D UPDATE^DIE("","FDA(1831)")
K FDA(1831)
;
I $P(ICDIAGP,U,10)]"" D
.S FDA(1831,80,"?1,",.01)="`"_ICDIP
.S FDA(1831,80.071,"?2,?1,",.01)=3071001
.S FDA(1831,80.711,"+10,?2,?1,",.01)=$P(ICDIAGP,U,10)
.D UPDATE^DIE("","FDA(1831)")
K FDA(1831)
;
I $P(ICDIAGP,U,11)]"" D
.S FDA(1831,80,"?1,",.01)="`"_ICDIP
.S FDA(1831,80.071,"?2,?1,",.01)=3071001
.S FDA(1831,80.711,"+11,?2,?1,",.01)=$P(ICDIAGP,U,11)
.D UPDATE^DIE("","FDA(1831)")
K FDA(1831)
;
I $P(ICDIAGP,U,12)]"" D
.S FDA(1831,80,"?1,",.01)="`"_ICDIP
.S FDA(1831,80.071,"?2,?1,",.01)=3071001
.S FDA(1831,80.711,"+12,?2,?1,",.01)=$P(ICDIAGP,U,12)
.D UPDATE^DIE("","FDA(1831)")
K FDA(1831)
;
I $O(^ICD9(ICDIP,4,0))="" D
.S FDA(1831,80,"?13,",.01)="`"_ICDIP
.S FDA(1831,80.072,"+14,?13,",.01)=3071001
.S FDA(1831,80.072,"+14,?13,",1)=$P(ICDIAGP,U,2)
.D UPDATE^DIE("","FDA(1831)")
.K FDA(1831)
K FDA(1831)
;
;for new Dx, place MDC in field #5
I $$GET1^DIQ(80,ICDIP_",",5,"I")="" D
.Q:($P(ICDIAGP,U,2)="")
.S FDA(1831,80,ICDIP_",",5)=$P(ICDIAGP,U,2)
.D FILE^DIE("","FDA(1831)")
.K FDA(1831)
;
I '$D(^TMP("DIERR",$J)) S ICDTOTP=ICDTOTP+1
;
I $D(^TMP("DIERR",$J)) D K ^TMP("DIERR",$J)
.S @ICDTMP@("ERROR",ICDIP,"80.1")="CANNOT FILE CODES FOR FY08 FOR IEN"_$P(ICDIAGP,U)_" CODES "_$P(ICDIAGP,3,99)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD1831J 7895 printed Dec 13, 2024@01:48:26 Page 2
ICD1831J ; ALB/ECF - FY 2008 UPDATE; 8/27/07 14:50
+1 ;;18.0;DRG Grouper;**31**;Oct 13,2000 2:30 pm;Build 7
+2 QUIT
+3 ;
DRG(ICDTMP) ;post-install driver for file ICD Diagnosis file(#80) DRG updates
+1 ;This procedure creates and files the MSv25DRG updates
+2 ;
+3 ; Input:
+4 ; ICDTMP - Temp file of error msg's
+5 ; ICDTOT - Total MS-DRG codes filed
+6 ; Output:
+7 ; ICDTMP - Temp file of error msg's
+8 ; ICDTOT - Total MS-DRG codes filed
+9 ; ICDERTOT - Total error records of type "cannot file"
+10 ;
+11 ; This is a rough but growing list of variables
NEW ICDI,ICDCRCD,ICDNWCD,ICDTOT,ICDETOT,ICDVAL,ICDXX,ICX1,ICDZZ
+12 SET U="^"
+13 SET (ICDI,ICDTOT,ICDETOT)=0
+14 SET ICDXX=""
+15 SET (ICDINAC,ICDAD)=0
+16 ;
+17 ;ANNOUNCE PROJECT
+18 ;
+19 DO BMES^XPDUTL(">>> Adding FY 2008 DRG Grouper updates to ICD Diagnosis file (#80)...")
+20 ;
+21 ;Set up reference to error log
+22 ;
+23 SET ICDTMP=$GET(ICDTMP)
+24 IF ICDTMP']""
SET ICDTMP=$NAME(^TMP("ICDDGFY2008D",$JOB))
Begin DoDot:1
+25 KILL @ICDTMP
+26 SET @ICDTMP@(0)="PATCH FY 2008 ICD DIAGNOSIS DRG UPDATE^"_$$NOW^XLFDT
End DoDot:1
+27 ;
+28 ;LOOP THROUGH FILE 80 - PROCESS EACH ENTRY
+29 ;All except inactive entries may have new DRGs
+30 ;
+31 FOR
SET ICDI=$ORDER(^ICD9(ICDI))
if ICDI=""!(ICDI'?.N)
QUIT
Begin DoDot:1
+32 ;quit if no zero node
+33 if $GET(^ICD9(ICDI,0))=""
QUIT
+34 ;quit if zero node corrupt
+35 if $PIECE($GET(^ICD9(ICDI,0)),U,1)']""
QUIT
+36 ;quit if code is inactive
+37 ;
+38 SET ICDVAL=$PIECE($GET(^ICD9(ICDI,0)),U)
+39 if ICDVAL=""
QUIT
+40 ;quit if code is inactive
+41 SET ICDZZ=$$ICDDX^ICDCODE(ICDVAL,3071001)
+42 if $PIECE($GET(ICDZZ),U,10)=0
QUIT
+43 ;
+44 ;check if already created in case patch being re-installed
+45 if $DATA(^ICD9(ICDI,3,"B",3071001))
SET ICDAD=ICDAD+1
+46 if $DATA(^ICD9(ICDI,3,"B",3071001))
QUIT
+47 ;
+48 ;Capture latest set of DRG codes (80.07) and latest MDC Effective Date's MDC (80.072)
+49 ;
+50 SET ICDCRCD=$$GETCRCD(ICDI)
+51 if ICDCRCD']""
QUIT
+52 ;
+53 ;Codes are passed to converter in string ICDCRCD <.01 field>^<MDC ien>^<DRG ien)^<DRG ien>...
+54 ;Function returns one set of codes, format is <.01 field>^<MDC ien>^<DRG ien)^<DRG ien>...
+55 ;If no converion values, then return format is <.01_field>_^_<mdc_ien>
+56 ;
+57 SET ICDNWCD=$$CONV80^ICD1831L(ICDCRCD)
+58 if $PIECE($GET(ICDNWCD),U,1)']""
QUIT
+59 if $PIECE($GET(ICDNWCD),U,2)']""
QUIT
+60 if $PIECE($GET(ICDNWCD),U,3)']""
QUIT
+61 ;pass new codes to update procedure
+62 ;
+63 DO UPDDIAG(ICDI,ICDNWCD,ICDTMP,.ICDTOT)
End DoDot:1
+64 ;
+65 ;
+66 ;HANDLE ERRORS
+67 ;No errors present
+68 ;
+69 IF '$DATA(@ICDTMP@("ERROR"))
Begin DoDot:1
+70 DO MES^XPDUTL(">>> ICD PROCEDURE File DRG Updates Completed...")
+71 DO MES^XPDUTL(" ...Total Codes Edited: "_ICDTOT)
+72 DO MES^XPDUTL("")
End DoDot:1
+73 ;Q
+74 ;Errors present
+75 ;
+76 IF $DATA(@ICDTMP@("ERROR"))
Begin DoDot:1
+77 FOR
SET ICDXX=$ORDER(^TMP("ICDDGFY2008D",$JOB,ICDXX))
if ICDXX=""
QUIT
Begin DoDot:2
+78 SET ICDETOT=ICDETOT+1
End DoDot:2
+79 DO MES^XPDUTL(">>> ...Total Errors "_ICDETOT_" ERRORS")
+80 DO MES^XPDUTL("")
+81 DO MES^XPDUTL("Error are in ^TMP(""ICDDGFY2008D"",$J)")
End DoDot:1
+82 ;
+83 KILL ICDCRCD,ICDVAL,ICDZZ
+84 QUIT
+85 ;
+86 ;END OF DRIVER
+87 ;
+88 ;Start of helper functions and procedures
+89 ;
GETCRCD(ICDI) ;
+1 ;INPUT ICDI = ien in file 80.1 ICD Diagnosis Codes
+2 ;OUTPUT ICCRCDS = string of current DRG Codes for latest DRG Grouper Effective Date
+3 ; and the latest MDC (80.072, #1)
+4 ;
+5 NEW ICDLDGED,ICDLMDED,ICDDGD2,ICDDGD3,ICDMDD1,ICDX,ICDCRCDS,ICDMDC
+6 ;LAST DRG EFFECTIVE DATE, LAST MDC EFFECTIVE DATE, IEN IN DRG EF DT, IEN IN DRG
+7 ;IEN IN MDC EFF DATE, STRING OF RETURN CODES, SCRATCH VARIABLE
+8 ;
+9 ;RETURN IEN^MDC^DRG^DRG^DRG..... (values are pointers)
+10 ;
+11 SET (ICDMDC,ICDCRCDS)=""
+12 ;
+13 ;START STRING WITH THE .01 FIELD OF THE ENTRY (ICDI)
+14 ;
+15 SET ICDCRCDS=$PIECE(^ICD9(ICDI,0),U,1)
+16 ;
+17 ;NEXT GET THE MDC ATTACHED TO THE LATEST MDC EFFECTIVE DATE
+18 ;
+19 SET ICDLMDED=$ORDER(^ICD9(ICDI,4,"B",9999999),-1)
+20 IF ICDLMDED]""
Begin DoDot:1
+21 SET ICDMDD1=$ORDER(^ICD9(ICDI,4,"B",ICDLMDED,0))
+22 SET ICDMDC=$PIECE($GET(^ICD9(ICDI,4,ICDMDD1,0)),U,2)
End DoDot:1
+23 SET ICDCRCDS=ICDCRCDS_"^"_$SELECT((ICDMDC)]"":ICDMDC,1:"")
+24 ;
+25 ;THEN GET THE DRG MULTIPLE CODES
+26 ;
+27 SET ICDLDGED=$ORDER(^ICD9(ICDI,3,"B",9999999),-1)
+28 ; new record - is active but has no DRG entries
if ICDLDGED=""
QUIT ICDCRCDS
+29 ;GET IEN IN DRG MULTIPLE
SET ICDDGD2=$ORDER(^ICD9(ICDI,3,"B",ICDLDGED,0))
+30 ;QUIT, SOMETHING IS WRONG
if $GET(^ICD9(ICDI,3,ICDDGD2,1,0))']""
QUIT ""
+31 SET ICDDGD3=0
+32 FOR
SET ICDDGD3=$ORDER(^ICD9(ICDI,3,ICDDGD2,1,ICDDGD3))
if ICDDGD3=""
QUIT
Begin DoDot:1
+33 SET ICDCRCDS=ICDCRCDS_"^"_$GET(^ICD9(ICDI,3,ICDDGD2,1,ICDDGD3,0))
End DoDot:1
+34 QUIT ICDCRCDS
+35 ;
+36 ;
UPDDIAG(ICDIP,ICDIAGP,ICDTMPP,ICDTOTP) ;
+1 ;Add 80.071 and 80.711 records for DRG Effective Date 10/1/07
+2 ;for both new and existing records
+3 ;
+4 ;Input ICDIP IEN in file 80
+5 ; ICDIAGP DRG string from CONV80^ICD1831L function
+6 ; format: <.01_field>^<mdc_ien>^<drg1_ien>^<drg2_ien>...
+7 ; ICDTMPP Error tracker - ^TMP(""CDDGFY2008D",$J)
+8 ; ICDTOT ICD Diagnosis Code File records sucessfully filed
+9 ;
+10 ;--------------------------------------------------------------------
+11 ;
+12 ; N ICDZ
+13 ; F ICDZ=1:1:3 I $P(ICDIAGP,U,ICDZ)']"" D Q
+14 ; .S @ICDTMP@("ERROR",ICDIP,68)="Missing field "_ICDZ_" filing "_ICDIAGP
+15 ;
+16 ;Add DRG FY08 Multiple
+17 ;
+18 KILL FDA(1831)
+19 SET FDA(1831,80,"?1,",.01)="`"_ICDIP
+20 SET FDA(1831,80.071,"+2,?1,",.01)=3071001
+21 DO UPDATE^DIE("","FDA(1831)")
+22 KILL FDA(1831)
+23 ;
+24 IF $PIECE(ICDIAGP,U,3)]""
Begin DoDot:1
+25 SET FDA(1831,80,"?1,",.01)="`"_ICDIP
+26 SET FDA(1831,80.071,"?2,?1,",.01)=3071001
+27 SET FDA(1831,80.711,"+3,?2,?1,",.01)=$PIECE(ICDIAGP,U,3)
+28 DO UPDATE^DIE("","FDA(1831)")
End DoDot:1
+29 KILL FDA(1831)
+30 ;
+31 ;
+32 IF $PIECE(ICDIAGP,U,4)]""
Begin DoDot:1
+33 SET FDA(1831,80,"?1,",.01)="`"_ICDIP
+34 SET FDA(1831,80.071,"?2,?1,",.01)=3071001
+35 SET FDA(1831,80.711,"+4,?2,?1,",.01)=$PIECE(ICDIAGP,U,4)
+36 DO UPDATE^DIE("","FDA(1831)")
End DoDot:1
+37 KILL FDA(1831)
+38 ;
+39 IF $PIECE(ICDIAGP,U,5)]""
Begin DoDot:1
+40 SET FDA(1831,80,"?1,",.01)="`"_ICDIP
+41 SET FDA(1831,80.071,"?2,?1,",.01)=3071001
+42 SET FDA(1831,80.711,"+5,?2,?1,",.01)=$PIECE(ICDIAGP,U,5)
+43 DO UPDATE^DIE("","FDA(1831)")
End DoDot:1
+44 KILL FDA(1831)
+45 ;
+46 IF $PIECE(ICDIAGP,U,6)]""
Begin DoDot:1
+47 SET FDA(1831,80,"?1,",.01)="`"_ICDIP
+48 SET FDA(1831,80.071,"?2,?1,",.01)=3071001
+49 SET FDA(1831,80.711,"+6,?2,?1,",.01)=$PIECE(ICDIAGP,U,6)
+50 DO UPDATE^DIE("","FDA(1831)")
End DoDot:1
+51 KILL FDA(1831)
+52 ;
+53 IF $PIECE(ICDIAGP,U,7)]""
Begin DoDot:1
+54 SET FDA(1831,80,"?1,",.01)="`"_ICDIP
+55 SET FDA(1831,80.071,"?2,?1,",.01)=3071001
+56 SET FDA(1831,80.711,"+7,?2,?1,",.01)=$PIECE(ICDIAGP,U,7)
+57 DO UPDATE^DIE("","FDA(1831)")
End DoDot:1
+58 KILL FDA(1831)
+59 ;
+60 ;
+61 IF $PIECE(ICDIAGP,U,8)]""
Begin DoDot:1
+62 SET FDA(1831,80,"?1,",.01)="`"_ICDIP
+63 SET FDA(1831,80.071,"?2,?1,",.01)=3071001
+64 SET FDA(1831,80.711,"+8,?2,?1,",.01)=$PIECE(ICDIAGP,U,8)
+65 DO UPDATE^DIE("","FDA(1831)")
End DoDot:1
+66 KILL FDA(1831)
+67 ;
+68 IF $PIECE(ICDIAGP,U,9)]""
Begin DoDot:1
+69 SET FDA(1831,80,"?1,",.01)="`"_ICDIP
+70 SET FDA(1831,80.071,"?2,?1,",.01)=3071001
+71 SET FDA(1831,80.711,"+9,?2,?1,",.01)=$PIECE(ICDIAGP,U,9)
+72 DO UPDATE^DIE("","FDA(1831)")
End DoDot:1
+73 KILL FDA(1831)
+74 ;
+75 IF $PIECE(ICDIAGP,U,10)]""
Begin DoDot:1
+76 SET FDA(1831,80,"?1,",.01)="`"_ICDIP
+77 SET FDA(1831,80.071,"?2,?1,",.01)=3071001
+78 SET FDA(1831,80.711,"+10,?2,?1,",.01)=$PIECE(ICDIAGP,U,10)
+79 DO UPDATE^DIE("","FDA(1831)")
End DoDot:1
+80 KILL FDA(1831)
+81 ;
+82 IF $PIECE(ICDIAGP,U,11)]""
Begin DoDot:1
+83 SET FDA(1831,80,"?1,",.01)="`"_ICDIP
+84 SET FDA(1831,80.071,"?2,?1,",.01)=3071001
+85 SET FDA(1831,80.711,"+11,?2,?1,",.01)=$PIECE(ICDIAGP,U,11)
+86 DO UPDATE^DIE("","FDA(1831)")
End DoDot:1
+87 KILL FDA(1831)
+88 ;
+89 IF $PIECE(ICDIAGP,U,12)]""
Begin DoDot:1
+90 SET FDA(1831,80,"?1,",.01)="`"_ICDIP
+91 SET FDA(1831,80.071,"?2,?1,",.01)=3071001
+92 SET FDA(1831,80.711,"+12,?2,?1,",.01)=$PIECE(ICDIAGP,U,12)
+93 DO UPDATE^DIE("","FDA(1831)")
End DoDot:1
+94 KILL FDA(1831)
+95 ;
+96 IF $ORDER(^ICD9(ICDIP,4,0))=""
Begin DoDot:1
+97 SET FDA(1831,80,"?13,",.01)="`"_ICDIP
+98 SET FDA(1831,80.072,"+14,?13,",.01)=3071001
+99 SET FDA(1831,80.072,"+14,?13,",1)=$PIECE(ICDIAGP,U,2)
+100 DO UPDATE^DIE("","FDA(1831)")
+101 KILL FDA(1831)
End DoDot:1
+102 KILL FDA(1831)
+103 ;
+104 ;for new Dx, place MDC in field #5
+105 IF $$GET1^DIQ(80,ICDIP_",",5,"I")=""
Begin DoDot:1
+106 if ($PIECE(ICDIAGP,U,2)="")
QUIT
+107 SET FDA(1831,80,ICDIP_",",5)=$PIECE(ICDIAGP,U,2)
+108 DO FILE^DIE("","FDA(1831)")
+109 KILL FDA(1831)
End DoDot:1
+110 ;
+111 IF '$DATA(^TMP("DIERR",$JOB))
SET ICDTOTP=ICDTOTP+1
+112 ;
+113 IF $DATA(^TMP("DIERR",$JOB))
Begin DoDot:1
+114 SET @ICDTMP@("ERROR",ICDIP,"80.1")="CANNOT FILE CODES FOR FY08 FOR IEN"_$PIECE(ICDIAGP,U)_" CODES "_$PIECE(ICDIAGP,3,99)
End DoDot:1
KILL ^TMP("DIERR",$JOB)
+115 QUIT
