source: WorldVistAEHR/trunk/r/DRG_GROUPER-ICD--ICPT/ICD1827G.m@ 1780

ICD1827G ;;BAY/JAT - FY 2007 UPDATE;

 ;;18.0;DRG Grouper;**27**;Oct 13,2000;Build 2

 ;

 D PRO

 D CC

 D DEL

 D KIL

 D DRG

 D ACCEPT

 Q

PRO ; update procedures with new identifier

 N LINE,X,ICDPROC,ENTRY,IDENT,DA,DIE,DR,DUPE

 F LINE=1:1 S X=$T(PROID+LINE) S ICDPROC=$P(X,";;",2) Q:ICDPROC="EXIT"  D

 .S ENTRY=+$O(^ICD0("BA",$P(ICDPROC,U)_" ",0)) I ENTRY D

 ..; check for any dupe (there are some in MNTVBB)

 ..S DUPE=+$O(^ICD0("BA",$P(ICDPROC,U)_" ",ENTRY)) I DUPE Q

 ..S IDENT=$P($G(^ICD0(ENTRY,0)),U,2)

 ..;check if already done in case being reinstalled

 ..I IDENT[$P(ICDPROC,U,2) Q

 ..S IDENT=IDENT_$P(ICDPROC,U,2)

 ..I $P(ICDPROC,U)="51.21" S IDENT="O"

 ..I $P(ICDPROC,U)="51.24" S IDENT="O"

 ..S DA=ENTRY,DIE="^ICD0("

 ..S DR="2///^S X=IDENT"

 ..D ^DIE

 Q

PROID ;

 ;;53.61^z

 ;;78.60^z

 ;;78.61^z

 ;;78.63^z

 ;;78.64^z

 ;;78.65^z

 ;;78.68^z

 ;;39.52^7

 ;;51.21^999999

 ;;51.24^999999

 ;;EXIT

CC ; update complications/comorbidities field in diag file

 N LINE,X,ICDDIAG,ENTRY,IDENT,DA,DIE,DR,DUPE

 F LINE=1:1 S X=$T(CCID+LINE) S ICDDIAG=$P(X,";;",2) Q:ICDDIAG="EXIT"  D

 .S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",0)) I ENTRY D

 ..; check for any dupe (there are some in MNTVBB)

 ..S DUPE=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",ENTRY)) I DUPE Q

 ..S IDENT=1

 ..S DA=ENTRY,DIE="^ICD9("

 ..S DR="70///^S X=IDENT"

 ..D ^DIE

 Q

CCID ;

 ;;707.00^

 ;;707.01^

 ;;707.02^

 ;;707.04^

 ;;707.05^

 ;;707.06^

 ;;707.09^

 ;;EXIT

DEL ; delete DRG 496 in procedure file

 N LINE,X,ICDPROC,ENTRY,ICIENS,FDA

 F LINE=1:1 S X=$T(REV+LINE) S ICDPROC=$P(X,";;",2) Q:ICDPROC="EXIT"  D

 .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 done in case patch being re-installed

 ..Q:'$D(^ICD0(ENTRY,2,1,1,2,1,"B",496,1))

 ..S ICIENS=1,ICIENS(1)=2,ICIENS(2)=1,ICIENS(3)=ENTRY

 ..S ICIENS=$$IENS^DILF(.ICIENS)

 ..S FDA(80.17111,ICIENS,.01)="@"

 ..D FILE^DIE("","FDA") K FDA

 ; delete DRG 223 in procedure file

 S ENTRY=+$O(^ICD0("BA",78.13_" ",0))

 I ENTRY D

 .;check for possible inactive dupe

 .I $P($G(^ICD0(ENTRY,0)),U,9)=1 S ENTRY=+$O(^ICD0("BA",78.13_" ",ENTRY)) I 'ENTRY Q

 .; check if already done in case patch being re-installed

 .Q:'$D(^ICD0(ENTRY,2,1,1,1,1,"B",223,1))

 .S ICIENS=1,ICIENS(1)=1,ICIENS(2)=1,ICIENS(3)=ENTRY

 .S ICIENS=$$IENS^DILF(.ICIENS)

 .S FDA(80.17111,ICIENS,.01)="@"

 .D FILE^DIE("","FDA") K FDA

 Q

REV ;

 ;;81.02^

 ;;81.03^

 ;;81.32^

 ;;81.33^

 ;;EXIT

KIL ; delete DRG 315 in diagnosis file

 N LINE,X,ICDDIAG,ENTRY,ICIENS,FDA

 F LINE=1:1 S X=$T(LIS+LINE) S ICDDIAG=$P(X,";;",2) Q:ICDDIAG="EXIT"  D

 .S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",0))

 .I ENTRY D

 ..;check for possible inactive dupe

 ..I $P($G(^ICD9(ENTRY,0)),U,9)=1 S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",ENTRY)) I 'ENTRY Q

 ..; check if already done in case patch being re-installed

 ..Q:'$D(^ICD9(ENTRY,3,1,1,"B",315,1))

 ..S ICIENS=1,ICIENS(1)=1,ICIENS(2)=ENTRY

 ..S ICIENS=$$IENS^DILF(.ICIENS)

 ..S FDA(80.711,ICIENS,.01)="@"

 ..D FILE^DIE("","FDA") K FDA

 Q

LIS ;

 ;;585.1^

 ;;585.2^

 ;;585.3^

 ;;585.4^

 ;;585.5^

 ;;585.6^

 ;;585.9^

 ;;EXIT

DRG ; update DRG in diag file

 N ENTRY,ICIENS,FDA

 S ENTRY=+$O(^ICD9("BA","724.8 ",0))

 I ENTRY D

 .; check if already done in case patch being re-installed

 .Q:$D(^ICD9(ENTRY,3,1,1,"B",243,1))

 .S ICIENS=1,ICIENS(1)=1,ICIENS(2)=ENTRY

 .S ICIENS=$$IENS^DILF(.ICIENS)

 .S FDA(80.711,ICIENS,.01)=243

 .D FILE^DIE("","FDA") K FDA

 S ENTRY=+$O(^ICD9("BA","053.19 ",0))

 I ENTRY D

 .; check if already done in case patch being re-installed

 .Q:$D(^ICD9(ENTRY,3,1,1,"B",18,1))

 .S ICIENS=1,ICIENS(1)=1,ICIENS(2)=ENTRY

 .S ICIENS=$$IENS^DILF(.ICIENS)

 .S FDA(80.711,ICIENS,.01)=18

 .D FILE^DIE("","FDA") K FDA

 Q

ACCEPT ; remove unacceptable as prime dx flag

 N LINE,X,ICDDIAG,ENTRY,IDENT,DUPE,FDA

 F LINE=1:1 S X=$T(ACPT+LINE) S ICDDIAG=$P(X,";;",2) Q:ICDDIAG="EXIT"  D

 .S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",0)) I ENTRY D

 ..; check for any dupe (there are some in MNTVBB)

 ..S DUPE=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",ENTRY)) I DUPE Q

 ..S IDENT=$P($G(^ICD9(ENTRY,0)),U,4)

 ..S FDA(80,ENTRY_",",101)="@"

 ..D FILE^DIE("","FDA") K FDA

 Q

ACPT ;

 ;;590.81^

 ;;595.4^

 ;;EXIT