ICD1822P ; ALB/JAT - NEW DIAGNOSIS CODES; 7/27/05 14:50;
;;18.0;DRG Grouper;**22**;Oct 13,2000
;
REMEDY ;
N FDA,DA,DIE,IDENT,DR,ICMED
;
; HD135282
;
; next line in case patch being re-installed
I $P(^ICD9(14197,3,1,1,0),U,4)=5 G NEXT
S FDA(1820,80,"?1,",.01)="`14197"
S FDA(1820,80.071,"?2,?1,",.01)=3051001
S FDA(1820,80.711,"+3,?2,?1,",.01)=406
S FDA(1820,80.711,"+4,?2,?1,",.01)=407
S FDA(1820,80.711,"+5,?2,?1,",.01)=408
D UPDATE^DIE("","FDA(1820)") K FDA(1820)
S FDA(1820,80,"?1,",.01)="`14198"
S FDA(1820,80.071,"?2,?1,",.01)=3051001
S FDA(1820,80.711,"+3,?2,?1,",.01)=406
S FDA(1820,80.711,"+4,?2,?1,",.01)=407
S FDA(1820,80.711,"+5,?2,?1,",.01)=408
D UPDATE^DIE("","FDA(1820)") K FDA(1820)
;
NEXT ;
; HD143411
;
S DA=4210
S DIE="^ICD0("
S IDENT="Og"
S DR="2///^S X=IDENT"
D ^DIE
;
; HD135520
;
S DA=541
S DIE="^ICD("
S ICMED=98
S DR="5///^S X=ICMED"
D ^DIE
S DA=542
S DIE="^ICD("
S ICMED=98
S DR="5///^S X=ICMED"
D ^DIE
S DA(1)=541
S DA=1
S DIE="^ICD(541,66,"
S DR=".05///^S X=ICMED"
D ^DIE
S DA(1)=542
S DA=1
S DIE="^ICD(542,66,"
S DR=".05///^S X=ICMED"
D ^DIE
;
; HD141351
;
D DIAG^ICD1822C
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD1822P 1223 printed Dec 13, 2024@01:48:06 Page 2
ICD1822P ; ALB/JAT - NEW DIAGNOSIS CODES; 7/27/05 14:50;
+1 ;;18.0;DRG Grouper;**22**;Oct 13,2000
+2 ;
REMEDY ;
+1 NEW FDA,DA,DIE,IDENT,DR,ICMED
+2 ;
+3 ; HD135282
+4 ;
+5 ; next line in case patch being re-installed
+6 IF $PIECE(^ICD9(14197,3,1,1,0),U,4)=5
GOTO NEXT
+7 SET FDA(1820,80,"?1,",.01)="`14197"
+8 SET FDA(1820,80.071,"?2,?1,",.01)=3051001
+9 SET FDA(1820,80.711,"+3,?2,?1,",.01)=406
+10 SET FDA(1820,80.711,"+4,?2,?1,",.01)=407
+11 SET FDA(1820,80.711,"+5,?2,?1,",.01)=408
+12 DO UPDATE^DIE("","FDA(1820)")
KILL FDA(1820)
+13 SET FDA(1820,80,"?1,",.01)="`14198"
+14 SET FDA(1820,80.071,"?2,?1,",.01)=3051001
+15 SET FDA(1820,80.711,"+3,?2,?1,",.01)=406
+16 SET FDA(1820,80.711,"+4,?2,?1,",.01)=407
+17 SET FDA(1820,80.711,"+5,?2,?1,",.01)=408
+18 DO UPDATE^DIE("","FDA(1820)")
KILL FDA(1820)
+19 ;
NEXT ;
+1 ; HD143411
+2 ;
+3 SET DA=4210
+4 SET DIE="^ICD0("
+5 SET IDENT="Og"
+6 SET DR="2///^S X=IDENT"
+7 DO ^DIE
+8 ;
+9 ; HD135520
+10 ;
+11 SET DA=541
+12 SET DIE="^ICD("
+13 SET ICMED=98
+14 SET DR="5///^S X=ICMED"
+15 DO ^DIE
+16 SET DA=542
+17 SET DIE="^ICD("
+18 SET ICMED=98
+19 SET DR="5///^S X=ICMED"
+20 DO ^DIE
+21 SET DA(1)=541
+22 SET DA=1
+23 SET DIE="^ICD(541,66,"
+24 SET DR=".05///^S X=ICMED"
+25 DO ^DIE
+26 SET DA(1)=542
+27 SET DA=1
+28 SET DIE="^ICD(542,66,"
+29 SET DR=".05///^S X=ICMED"
+30 DO ^DIE
+31 ;
+32 ; HD141351
+33 ;
+34 DO DIAG^ICD1822C
+35 QUIT
