ICD1848Y ;ALB/EG/MJB - PX UPDATES;6/24/05 3:29pm
;;18.0;DRG Grouper;**48**;Oct 13,2000;Build 7
;
; 2 line tags are in this routine. See ICD18XXP to find which tag
;is being called. Not all are used for each patch.
;These tags are for any needed corrections to DRG Groupings.
;PRO - is for making changes to the procedure code, add drg effective
;date,etc (fields will be in REV linetag)
;ID is to add or update an identifier for a procedure code(fields
; will be in REVID)
Q
;
PRO ;
D BMES^XPDUTL(">>>Modifying procedure codes - file 80.1")
D MES^XPDUTL(">>>for new DRGs")
N LINE,ICDX,ICDPROC,ENTRY,SUBLINE,DATA,FDA
F LINE=1:1 S ICDX=$T(REV+LINE) S ICDPROC=$P(ICDX,";;",2) Q:ICDPROC="EXIT" D
.Q:ICDPROC["+"
.S ENTRY=+$O(^ICD0("BA",$P(ICDPROC,U)_" ",0))
.I ENTRY D
..;check for possible inactive dupe
..I $P($G(^ICD0(ENTRY,0)),U,9)=1 S ENTRY=+$O(^ICD0("BA",$P(ICDPROC,U)_" ",ENTRY)) I 'ENTRY Q
..; check if already created in case patch being re-installed
..Q:$D(^ICD0(ENTRY,2,"B",3081001))
..;add 80.171, 80.1711 and 80.17111 records
..F SUBLINE=1:1 S ICDX=$T(REV+LINE+SUBLINE) S DATA=$P(ICDX,";;",2) Q:DATA'["+" D
...I SUBLINE=1 D
....S FDA(1820,80.1,"?1,",.01)="`"_ENTRY
....S FDA(1820,80.171,"+2,?1,",.01)=3081001
....D UPDATE^DIE("","FDA(1820)") K FDA(1820)
...S DATA=$E(DATA,2,99)
...S FDA(1820,80.1,"?1,",.01)="`"_ENTRY
...S FDA(1820,80.171,"?2,?1,",.01)=3081001
...S FDA(1820,80.1711,"+3,?2,?1,",.01)=$P(DATA,U)
...D UPDATE^DIE("","FDA(1820)") K FDA(1820)
...S FDA(1820,80.1,"?1,",.01)="`"_ENTRY
...S FDA(1820,80.171,"?2,?1,",.01)=3081001
...S FDA(1820,80.1711,"?3,?2,?1,",.01)=$P(DATA,U)
...S FDA(1820,80.17111,"+4,?3,?2,?1,",.01)=$P(DATA,U,2)
...I $P(DATA,U,3) S FDA(1820,80.17111,"+5,?3,?2,?1,",.01)=$P(DATA,U,3)
...I $P(DATA,U,4) S FDA(1820,80.17111,"+6,?3,?2,?1,",.01)=$P(DATA,U,4)
...I $P(DATA,U,5) S FDA(1820,80.17111,"+7,?3,?2,?1,",.01)=$P(DATA,U,5)
...I $P(DATA,U,6) S FDA(1820,80.17111,"+8,?3,?2,?1,",.01)=$P(DATA,U,6)
...I $P(DATA,U,7) S FDA(1820,80.17111,"+9,?3,?2,?1,",.01)=$P(DATA,U,7)
...D UPDATE^DIE("","FDA(1820)") K FDA(1820)
Q
ID ;modify Identifier field (#2) in file 80.1
N LINE,ICDX,ICDPROC,ENTRY,DA,DIE,DR,IDENT,DIC
F LINE=1:1 S ICDX=$T(REVID+LINE) S ICDPROC=$P(ICDX,";;",2) Q:ICDPROC="EXIT" D
.S ENTRY=+$O(^ICD0("BA",$P(ICDPROC,U)_" ",0))
.; check if already done in case patch is being re-installed
.S IDENT=$P($G(^ICD0(ENTRY,0)),U,2)
.S IDENA=$P(ICDPROC,U,2)
.I IDENT[IDENA D ICDMSG Q
.S IDENT=IDENT_IDENA D
.S DA=ENTRY,DIE="^ICD0("
.S DR="2///^S X=IDENT"
.D ^DIE
Q
;
ICDMSG ;
D BMES^XPDUTL(">>> IDENTIFIER ALREADY UPDATED - NO CHANGE HAS BEEN MADE ")
D MES^XPDUTL(" TO PROCEDURE CODE: "_ICDPROC) Q
REV ;changes to procedure, if any
;;EXIT
;;
REVID ; PX code,Identifier - additions, changes or deletions, if any of PX identifiers.
;;81.05^OF
;;81.63^OF
;;57.93^Of
;;EXIT
ICD1848Y ;ALB/EG/MJB - PX UPDATES;6/24/05 3:29pm
+1 ;;18.0;DRG Grouper;**48**;Oct 13,2000;Build 7
+2 ;
+3 ; 2 line tags are in this routine. See ICD18XXP to find which tag
+4 ;is being called. Not all are used for each patch.
+5 ;These tags are for any needed corrections to DRG Groupings.
+6 ;PRO - is for making changes to the procedure code, add drg effective
+7 ;date,etc (fields will be in REV linetag)
+8 ;ID is to add or update an identifier for a procedure code(fields
+9 ; will be in REVID)
+10 QUIT
+11 ;
PRO ;
+1 DO BMES^XPDUTL(">>>Modifying procedure codes - file 80.1")
+2 DO MES^XPDUTL(">>>for new DRGs")
+3 NEW LINE,ICDX,ICDPROC,ENTRY,SUBLINE,DATA,FDA
+4 FOR LINE=1:1
SET ICDX=$TEXT(REV+LINE)
SET ICDPROC=$PIECE(ICDX,";;",2)
IF ICDPROC="EXIT"
QUIT
Begin DoDot:1
+5 IF ICDPROC["+"
QUIT
+6 SET ENTRY=+$ORDER(^ICD0("BA",$PIECE(ICDPROC,U)_" ",0))
+7 IF ENTRY
Begin DoDot:2
+8 ;check for possible inactive dupe
+9 IF $PIECE($GET(^ICD0(ENTRY,0)),U,9)=1
SET ENTRY=+$ORDER(^ICD0("BA",$PIECE(ICDPROC,U)_" ",ENTRY))
IF 'ENTRY
QUIT
+10 ; check if already created in case patch being re-installed
+11 IF $DATA(^ICD0(ENTRY,2,"B",3081001))
QUIT
+12 ;add 80.171, 80.1711 and 80.17111 records
+13 FOR SUBLINE=1:1
SET ICDX=$TEXT(REV+LINE+SUBLINE)
SET DATA=$PIECE(ICDX,";;",2)
IF DATA'["+"
QUIT
Begin DoDot:3
+14 IF SUBLINE=1
Begin DoDot:4
+15 SET FDA(1820,80.1,"?1,",.01)="`"_ENTRY
+16 SET FDA(1820,80.171,"+2,?1,",.01)=3081001
+17 DO UPDATE^DIE("","FDA(1820)")
KILL FDA(1820)
End DoDot:4
+18 SET DATA=$EXTRACT(DATA,2,99)
+19 SET FDA(1820,80.1,"?1,",.01)="`"_ENTRY
+20 SET FDA(1820,80.171,"?2,?1,",.01)=3081001
+21 SET FDA(1820,80.1711,"+3,?2,?1,",.01)=$PIECE(DATA,U)
+22 DO UPDATE^DIE("","FDA(1820)")
KILL FDA(1820)
+23 SET FDA(1820,80.1,"?1,",.01)="`"_ENTRY
+24 SET FDA(1820,80.171,"?2,?1,",.01)=3081001
+25 SET FDA(1820,80.1711,"?3,?2,?1,",.01)=$PIECE(DATA,U)
+26 SET FDA(1820,80.17111,"+4,?3,?2,?1,",.01)=$PIECE(DATA,U,2)
+27 IF $PIECE(DATA,U,3)
SET FDA(1820,80.17111,"+5,?3,?2,?1,",.01)=$PIECE(DATA,U,3)
+28 IF $PIECE(DATA,U,4)
SET FDA(1820,80.17111,"+6,?3,?2,?1,",.01)=$PIECE(DATA,U,4)
+29 IF $PIECE(DATA,U,5)
SET FDA(1820,80.17111,"+7,?3,?2,?1,",.01)=$PIECE(DATA,U,5)
+30 IF $PIECE(DATA,U,6)
SET FDA(1820,80.17111,"+8,?3,?2,?1,",.01)=$PIECE(DATA,U,6)
+31 IF $PIECE(DATA,U,7)
SET FDA(1820,80.17111,"+9,?3,?2,?1,",.01)=$PIECE(DATA,U,7)
+32 DO UPDATE^DIE("","FDA(1820)")
KILL FDA(1820)
End DoDot:3
End DoDot:2
End DoDot:1
+33 QUIT
ID ;modify Identifier field (#2) in file 80.1
+1 NEW LINE,ICDX,ICDPROC,ENTRY,DA,DIE,DR,IDENT,DIC
+2 FOR LINE=1:1
SET ICDX=$TEXT(REVID+LINE)
SET ICDPROC=$PIECE(ICDX,";;",2)
IF ICDPROC="EXIT"
QUIT
Begin DoDot:1
+3 SET ENTRY=+$ORDER(^ICD0("BA",$PIECE(ICDPROC,U)_" ",0))
+4 ; check if already done in case patch is being re-installed
+5 SET IDENT=$PIECE($GET(^ICD0(ENTRY,0)),U,2)
+6 SET IDENA=$PIECE(ICDPROC,U,2)
+7 IF IDENT[IDENA
DO ICDMSG
QUIT
+8 SET IDENT=IDENT_IDENA
Begin DoDot:2
End DoDot:2
+9 SET DA=ENTRY
SET DIE="^ICD0("
+10 SET DR="2///^S X=IDENT"
+11 DO ^DIE
End DoDot:1
+12 QUIT
+13 ;
ICDMSG ;
+1 DO BMES^XPDUTL(">>> IDENTIFIER ALREADY UPDATED - NO CHANGE HAS BEEN MADE ")
+2 DO MES^XPDUTL(" TO PROCEDURE CODE: "_ICDPROC)
QUIT
REV ;changes to procedure, if any
+1 ;;EXIT
+2 ;;
REVID ; PX code,Identifier - additions, changes or deletions, if any of PX identifiers.
+1 ;;81.05^OF
+2 ;;81.63^OF
+3 ;;57.93^Of
+4 ;;EXIT
