source: FOIAVistA/tag/r/ASISTS-OOPS/OOPSXV2.m@ 824

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