Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ICD1861L

ICD1861L.m

Go to the documentation of this file.
ICD1861L ;ALB/JDG - UPDATE DX & PX CODES;7/27/05 14:50; 10/5/11 3:23pm
 ;;18.0;DRG Grouper;**61**;Oct 20, 2000;Build 7
 ;
 Q
 ;
 ;DX - update DX identifier(s)
ICDDX ;Update Dx
 D BMES^XPDUTL(">>> UPDATING DX CODE 767.2 IDENTIFIER...")
 N LINE,DXTXT,ICDDXDA,DA,DIE,IDENT,DR
 S DIE="^ICD9(",DR="2///^S X=IDENT"
 F LINE=1:1 S DXTXT=$T(PROC+LINE) S ICDDXDA=$P(DXTXT,";;",2) Q:ICDDXDA="EXIT"  D
 .S DA=ICDDXDA
 .S IDENT="S"
 .D ^DIE
 .Q
 D BMES^XPDUTL(">>> UPDATING DX CODE 959.09 IDENTIFIER...")
 N LINE,DXTXT,ICDDXDA3,DA,IDENT
 F LINE=1:1 S DXTXT=$T(PROC3+LINE) S ICDDXDA3=$P(DXTXT,";;",2) Q:ICDDXDA3="EXIT"  D
 .S DA=ICDDXDA3
 .S IDENT="T"
 .D ^DIE
 .Q
 Q
 ;
 ;PX - update PX identifier(s)
ICDPX ;Update Px
 D BMES^XPDUTL(">>> UPDATING PX CODE 37.22 IDENTIFIER...")
 N LINE,PXTXT,ICDPXDA,DA,IDENT
 S DIE="^ICD0(",DR="2///^S X=IDENT"
 F LINE=1:1 S PXTXT=$T(PROC1+LINE) S ICDPXDA=$P(PXTXT,";;",2) Q:ICDPXDA="EXIT"  D
 .S DA=ICDPXDA
 .S IDENT="HNp"
 .D ^DIE
 .Q
 D BMES^XPDUTL(">>> UPDATING PX CODE 37.72 IDENTIFIER...")
 N LINE,PXTXT,ICDPXDA1,DA,IDENT
 F LINE=1:1 S PXTXT=$T(PROC2+LINE) S ICDPXDA1=$P(PXTXT,";;",2) Q:ICDPXDA1="EXIT"  D
 .S DA=ICDPXDA1
 .S IDENT="oVp"
 .D ^DIE
 .Q
 Q
 ;
PROC ;
 ;;5307
 ;;EXIT
 ;
PROC1 ;
 ;;579
 ;;EXIT
 ;
PROC2 ;
 ;;594
 ;;EXIT
 ;
PROC3 ;
 ;;13350
 ;;EXIT