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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSXV2 3872 printed Nov 22, 2024@16:50:12 Page 2
OOPSXV2 ;WIOFO/LLH-PRE INIT ROUTINE TO FIX FILE 2263.2 ;02/07/02
+1 ;;2.0;ASISTS;;Jun 03, 2002
+2 ; 2/7/2002 - Added fix for Table files to remove colon from name
+3 ; Cant use ^DIE-input transform prevents edits
+4 NEW MSG
+5 SET MSG="Modifying ASISTS DOL CAUSE OF INJURY CODE Table File (#2263.2)"
+6 DO BMES^XPDUTL(MSG)
HANG 1
+7 DO MES^XPDUTL(" ")
+8 NEW NA,NA2,IEN,CHG,DA,DIC,DIE,DR
+9 SET IEN=0
SET DIC=2263.2
+10 FOR
SET IEN=$ORDER(^OOPS(DIC,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+11 SET (NA,NA2)=$$GET1^DIQ(DIC,IEN,.01)
SET CHG=""
+12 IF NA[":"
SET NA=$TRANSLATE(NA,":","- ")
SET CHG=1
+13 IF CHG=""
QUIT
+14 ; use NA2 for original name
+15 SET CODE=$$GET1^DIQ(DIC,IEN,1,"I")
+16 KILL ^OOPS(DIC,"B",NA2,IEN)
+17 KILL ^OOPS(DIC,"C",$EXTRACT(CODE,1,3),IEN)
+18 KILL ^OOPS(DIC,"D",$$UP^OOPSUTL4($EXTRACT(NA2,1,30)),IEN)
+19 ; use NA for new Name
+20 SET $PIECE(^OOPS(DIC,IEN,0),U)=NA
+21 SET ^OOPS(DIC,"B",NA,IEN)=""
+22 SET ^OOPS(DIC,"C",$EXTRACT(CODE,1,3),IEN)=""
+23 SET ^OOPS(DIC,"D",$$UP^OOPSUTL4($EXTRACT(NA,1,30)),IEN)=""
End DoDot:1
SRCCD ; Clean up 2 entries in OWCP Source Code table
+1 SET MSG="Modifying ASISTS DOL SOURCE OF INJURY CODES Table File (#2263.1)"
+2 DO BMES^XPDUTL(MSG)
HANG 1
+3 DO MES^XPDUTL(" ")
+4 IF $PIECE(^OOPS(2263.1,26,0),U)="Hand tool (powered: saw"
Begin DoDot:1
+5 SET $PIECE(^OOPS(2263.1,26,0),U)="Hand tool (powered saw)"
+6 KILL ^OOPS(2263.1,"B","Hand tool (powered: saw",26)
+7 SET ^OOPS(2263.1,"B","Hand tool (powered saw)",26)=""
+8 KILL ^OOPS(2263.1,"D","HAND TOOL (POWERED: SAW",26)
+9 SET ^OOPS(2263.1,"D","HAND TOOL (POWERED SAW)",26)=""
End DoDot:1
+10 IF $PIECE(^OOPS(2263.1,67,0),U)="Liquid Chemical:"
Begin DoDot:1
+11 SET $PIECE(^OOPS(2263.1,67,0),U)="Liquid Chemical"
+12 KILL ^OOPS(2263.1,"B","Liquid Chemical:",67)
+13 SET ^OOPS(2263.1,"B","Liquid Chemical",67)=""
+14 KILL ^OOPS(2263.1,"D","LIQUID CHEMICAL:",67)
+15 SET ^OOPS(2263.1,"D","LIQUID CHEMICAL",67)=""
End DoDot:1
NOICD ; Clean up 3 entries in OWCP NOI code table
+1 SET MSG="Modifying ASISTS DOL NATURE OF INJURY CODES Table File (#2263.3)"
+2 DO BMES^XPDUTL(MSG)
HANG 1
+3 DO MES^XPDUTL(" ")
+4 IF $PIECE(^OOPS(2263.3,13,0),U)="GENERAL SYMPTOMS: SYNCOPE, DIZZINESS, VERTIGO, FATIGUE, NUMBNESS OF BODY PART"
Begin DoDot:1
+5 SET $PIECE(^OOPS(2263.3,13,0),U)="GENERAL SYMPTOMS- SYNCOPE, DIZZINESS, VERTIGO, FATIGUE, NUMBNESS OF BODY PART"
+6 KILL ^OOPS(2263.3,"B","GENERAL SYMPTOMS: SYNCOPE, DIZZINESS, VERTIGO, FATIGUE, NUMBNESS OF BO",13)
+7 SET ^OOPS(2263.3,"B","GENERAL SYMPTOMS- SYNCOPE, DIZZINESS, VERTIGO, FATIGUE, NUMBNESS OF BO",13)=""
+8 KILL ^OOPS(2263.3,"D","GENERAL SYMPTOMS: SYNCOPE, DIZ",13)
+9 SET ^OOPS(2263.3,"D","GENERAL SYMPTOMS- SYNCOPE, DIZ",13)=""
End DoDot:1
+10 IF $PIECE(^OOPS(2263.3,68,0),U)="SKIN CONDITIONS: ALLERGY, ECZEMA, DERMATITIS"
Begin DoDot:1
+11 SET $PIECE(^OOPS(2263.3,68,0),U)="SKIN CONDITIONS- ALLERGY, ECZEMA, DERMATITIS"
+12 KILL ^OOPS(2263.3,"B","SKIN CONDITIONS: ALLERGY, ECZEMA, DERMATITIS",68)
+13 SET ^OOPS(2263.3,"B","SKIN CONDITIONS- ALLERGY, ECZEMA, DERMATITIS",68)=""
+14 KILL ^OOPS(2263.3,"D","SKIN CONDITIONS: ALLERGY, ECZE",68)
+15 SET ^OOPS(2263.3,"D","SKIN CONDITIONS- ALLERGY, ECZE",68)=""
End DoDot:1
+16 IF $PIECE(^OOPS(2263.3,83,0),U)="INFECTIOUS DISEASES: BACTERIA, VIRUSES, PARASITES"
Begin DoDot:1
+17 SET $PIECE(^OOPS(2263.3,83,0),U)="INFECTIOUS DISEASES- BACTERIA, VIRUSES, PARASITES"
+18 KILL ^OOPS(2263.3,"B","INFECTIOUS DISEASES: BACTERIA, VIRUSES, PARASITES",83)
+19 SET ^OOPS(2263.3,"B","INFECTIOUS DISEASES- BACTERIA, VIRUSES, PARASITES",83)=""
+20 KILL ^OOPS(2263.3,"D","INFECTIOUS DISEASES: BACTERIA,",83)
+21 SET ^OOPS(2263.3,"D","INFECTIOUS DISEASES- BACTERIA,",83)=""
End DoDot:1
+22 DO BMES^XPDUTL("Table updates complete.")
+23 QUIT
BODYPTS ;
+1 NEW DA,DIK,DIC,DIE,DR,FLG,BODY,BODY1,IEN,STR
+2 IF $DATA(^OOPS(2261.1,5,0))
SET DA=5
SET DIK="^OOPS(2261.1,"
DO ^DIK
+3 IF $$GET1^DIQ(2261.1,101,.01)'="INTESTINES"
Begin DoDot:1
+4 SET (DIC,DIE)="^OOPS(2261.1,"
SET DA=101
SET DR=".01////INTESTINES"
DO ^DIE
End DoDot:1
+5 ; now make sure no ASISTS Records with a pointer = 5 in field 30, 30.1
+6 SET IEN=0
+7 FOR
SET IEN=$ORDER(^OOPS(2260,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+8 SET STR=$GET(^OOPS(2260,IEN,"2162B"))
SET FLG=0
+9 IF $PIECE($GET(STR),U,4)=5
SET $PIECE(STR,U,4)=101
SET FLG=1
+10 IF $PIECE($GET(STR),U,8)=5
SET $PIECE(STR,U,8)=101
SET FLG=1
+11 IF FLG
SET ^OOPS(2260,IEN,"2162B")=STR
End DoDot:1
+12 QUIT
