78 lines
3.7 KiB
Mathematica
78 lines
3.7 KiB
Mathematica
OOPSXV2 ;WIOFO/LLH-PRE INIT ROUTINE TO FIX FILE 2263.2 ;02/07/02
|
|
;;2.0;ASISTS;;Jun 03, 2002
|
|
; 2/7/2002 - Added fix for Table files to remove colon from name
|
|
; Cant use ^DIE-input transform prevents edits
|
|
N MSG
|
|
S MSG="Modifying ASISTS DOL CAUSE OF INJURY CODE Table File (#2263.2)"
|
|
D BMES^XPDUTL(MSG) H 1
|
|
D MES^XPDUTL(" ")
|
|
N NA,NA2,IEN,CHG,DA,DIC,DIE,DR
|
|
S IEN=0,DIC=2263.2
|
|
F S IEN=$O(^OOPS(DIC,IEN)) Q:IEN'>0 D
|
|
. S (NA,NA2)=$$GET1^DIQ(DIC,IEN,.01),CHG=""
|
|
. I NA[":" S NA=$TR(NA,":","- "),CHG=1
|
|
. I CHG="" Q
|
|
. ; use NA2 for original name
|
|
. S CODE=$$GET1^DIQ(DIC,IEN,1,"I")
|
|
. K ^OOPS(DIC,"B",NA2,IEN)
|
|
. K ^OOPS(DIC,"C",$E(CODE,1,3),IEN)
|
|
. K ^OOPS(DIC,"D",$$UP^OOPSUTL4($E(NA2,1,30)),IEN)
|
|
. ; use NA for new Name
|
|
. S $P(^OOPS(DIC,IEN,0),U)=NA
|
|
. S ^OOPS(DIC,"B",NA,IEN)=""
|
|
. S ^OOPS(DIC,"C",$E(CODE,1,3),IEN)=""
|
|
. S ^OOPS(DIC,"D",$$UP^OOPSUTL4($E(NA,1,30)),IEN)=""
|
|
SRCCD ; Clean up 2 entries in OWCP Source Code table
|
|
S MSG="Modifying ASISTS DOL SOURCE OF INJURY CODES Table File (#2263.1)"
|
|
D BMES^XPDUTL(MSG) H 1
|
|
D MES^XPDUTL(" ")
|
|
I $P(^OOPS(2263.1,26,0),U)="Hand tool (powered: saw" D
|
|
.S $P(^OOPS(2263.1,26,0),U)="Hand tool (powered saw)"
|
|
.K ^OOPS(2263.1,"B","Hand tool (powered: saw",26)
|
|
.S ^OOPS(2263.1,"B","Hand tool (powered saw)",26)=""
|
|
.K ^OOPS(2263.1,"D","HAND TOOL (POWERED: SAW",26)
|
|
.S ^OOPS(2263.1,"D","HAND TOOL (POWERED SAW)",26)=""
|
|
I $P(^OOPS(2263.1,67,0),U)="Liquid Chemical:" D
|
|
.S $P(^OOPS(2263.1,67,0),U)="Liquid Chemical"
|
|
.K ^OOPS(2263.1,"B","Liquid Chemical:",67)
|
|
.S ^OOPS(2263.1,"B","Liquid Chemical",67)=""
|
|
.K ^OOPS(2263.1,"D","LIQUID CHEMICAL:",67)
|
|
.S ^OOPS(2263.1,"D","LIQUID CHEMICAL",67)=""
|
|
NOICD ; Clean up 3 entries in OWCP NOI code table
|
|
S MSG="Modifying ASISTS DOL NATURE OF INJURY CODES Table File (#2263.3)"
|
|
D BMES^XPDUTL(MSG) H 1
|
|
D MES^XPDUTL(" ")
|
|
I $P(^OOPS(2263.3,13,0),U)="GENERAL SYMPTOMS: SYNCOPE, DIZZINESS, VERTIGO, FATIGUE, NUMBNESS OF BODY PART" D
|
|
.S $P(^OOPS(2263.3,13,0),U)="GENERAL SYMPTOMS- SYNCOPE, DIZZINESS, VERTIGO, FATIGUE, NUMBNESS OF BODY PART"
|
|
.K ^OOPS(2263.3,"B","GENERAL SYMPTOMS: SYNCOPE, DIZZINESS, VERTIGO, FATIGUE, NUMBNESS OF BO",13)
|
|
.S ^OOPS(2263.3,"B","GENERAL SYMPTOMS- SYNCOPE, DIZZINESS, VERTIGO, FATIGUE, NUMBNESS OF BO",13)=""
|
|
.K ^OOPS(2263.3,"D","GENERAL SYMPTOMS: SYNCOPE, DIZ",13)
|
|
.S ^OOPS(2263.3,"D","GENERAL SYMPTOMS- SYNCOPE, DIZ",13)=""
|
|
I $P(^OOPS(2263.3,68,0),U)="SKIN CONDITIONS: ALLERGY, ECZEMA, DERMATITIS" D
|
|
.S $P(^OOPS(2263.3,68,0),U)="SKIN CONDITIONS- ALLERGY, ECZEMA, DERMATITIS"
|
|
.K ^OOPS(2263.3,"B","SKIN CONDITIONS: ALLERGY, ECZEMA, DERMATITIS",68)
|
|
.S ^OOPS(2263.3,"B","SKIN CONDITIONS- ALLERGY, ECZEMA, DERMATITIS",68)=""
|
|
.K ^OOPS(2263.3,"D","SKIN CONDITIONS: ALLERGY, ECZE",68)
|
|
.S ^OOPS(2263.3,"D","SKIN CONDITIONS- ALLERGY, ECZE",68)=""
|
|
I $P(^OOPS(2263.3,83,0),U)="INFECTIOUS DISEASES: BACTERIA, VIRUSES, PARASITES" D
|
|
.S $P(^OOPS(2263.3,83,0),U)="INFECTIOUS DISEASES- BACTERIA, VIRUSES, PARASITES"
|
|
.K ^OOPS(2263.3,"B","INFECTIOUS DISEASES: BACTERIA, VIRUSES, PARASITES",83)
|
|
.S ^OOPS(2263.3,"B","INFECTIOUS DISEASES- BACTERIA, VIRUSES, PARASITES",83)=""
|
|
.K ^OOPS(2263.3,"D","INFECTIOUS DISEASES: BACTERIA,",83)
|
|
.S ^OOPS(2263.3,"D","INFECTIOUS DISEASES- BACTERIA,",83)=""
|
|
D BMES^XPDUTL("Table updates complete.")
|
|
Q
|
|
BODYPTS ;
|
|
N DA,DIK,DIC,DIE,DR,FLG,BODY,BODY1,IEN,STR
|
|
I $D(^OOPS(2261.1,5,0)) S DA=5,DIK="^OOPS(2261.1," D ^DIK
|
|
I $$GET1^DIQ(2261.1,101,.01)'="INTESTINES" D
|
|
.S (DIC,DIE)="^OOPS(2261.1,",DA=101,DR=".01////INTESTINES" D ^DIE
|
|
; now make sure no ASISTS Records with a pointer = 5 in field 30, 30.1
|
|
S IEN=0
|
|
F S IEN=$O(^OOPS(2260,IEN)) Q:IEN'>0 D
|
|
.S STR=$G(^OOPS(2260,IEN,"2162B")),FLG=0
|
|
.I $P($G(STR),U,4)=5 S $P(STR,U,4)=101,FLG=1
|
|
.I $P($G(STR),U,8)=5 S $P(STR,U,8)=101,FLG=1
|
|
.I FLG S ^OOPS(2260,IEN,"2162B")=STR
|
|
Q
|