source: FOIAVistA/trunk/r/ASISTS-OOPS/OOPSXV2.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1OOPSXV2 ;WIOFO/LLH-PRE INIT ROUTINE TO FIX FILE 2263.2 ;02/07/02
2 ;;2.0;ASISTS;;Jun 03, 2002
3 ; 2/7/2002 - Added fix for Table files to remove colon from name
4 ; Cant use ^DIE-input transform prevents edits
5 N MSG
6 S MSG="Modifying ASISTS DOL CAUSE OF INJURY CODE Table File (#2263.2)"
7 D BMES^XPDUTL(MSG) H 1
8 D MES^XPDUTL(" ")
9 N NA,NA2,IEN,CHG,DA,DIC,DIE,DR
10 S IEN=0,DIC=2263.2
11 F S IEN=$O(^OOPS(DIC,IEN)) Q:IEN'>0 D
12 . S (NA,NA2)=$$GET1^DIQ(DIC,IEN,.01),CHG=""
13 . I NA[":" S NA=$TR(NA,":","- "),CHG=1
14 . I CHG="" Q
15 . ; use NA2 for original name
16 . S CODE=$$GET1^DIQ(DIC,IEN,1,"I")
17 . K ^OOPS(DIC,"B",NA2,IEN)
18 . K ^OOPS(DIC,"C",$E(CODE,1,3),IEN)
19 . K ^OOPS(DIC,"D",$$UP^OOPSUTL4($E(NA2,1,30)),IEN)
20 . ; use NA for new Name
21 . S $P(^OOPS(DIC,IEN,0),U)=NA
22 . S ^OOPS(DIC,"B",NA,IEN)=""
23 . S ^OOPS(DIC,"C",$E(CODE,1,3),IEN)=""
24 . S ^OOPS(DIC,"D",$$UP^OOPSUTL4($E(NA,1,30)),IEN)=""
25SRCCD ; Clean up 2 entries in OWCP Source Code table
26 S MSG="Modifying ASISTS DOL SOURCE OF INJURY CODES Table File (#2263.1)"
27 D BMES^XPDUTL(MSG) H 1
28 D MES^XPDUTL(" ")
29 I $P(^OOPS(2263.1,26,0),U)="Hand tool (powered: saw" D
30 .S $P(^OOPS(2263.1,26,0),U)="Hand tool (powered saw)"
31 .K ^OOPS(2263.1,"B","Hand tool (powered: saw",26)
32 .S ^OOPS(2263.1,"B","Hand tool (powered saw)",26)=""
33 .K ^OOPS(2263.1,"D","HAND TOOL (POWERED: SAW",26)
34 .S ^OOPS(2263.1,"D","HAND TOOL (POWERED SAW)",26)=""
35 I $P(^OOPS(2263.1,67,0),U)="Liquid Chemical:" D
36 .S $P(^OOPS(2263.1,67,0),U)="Liquid Chemical"
37 .K ^OOPS(2263.1,"B","Liquid Chemical:",67)
38 .S ^OOPS(2263.1,"B","Liquid Chemical",67)=""
39 .K ^OOPS(2263.1,"D","LIQUID CHEMICAL:",67)
40 .S ^OOPS(2263.1,"D","LIQUID CHEMICAL",67)=""
41NOICD ; Clean up 3 entries in OWCP NOI code table
42 S MSG="Modifying ASISTS DOL NATURE OF INJURY CODES Table File (#2263.3)"
43 D BMES^XPDUTL(MSG) H 1
44 D MES^XPDUTL(" ")
45 I $P(^OOPS(2263.3,13,0),U)="GENERAL SYMPTOMS: SYNCOPE, DIZZINESS, VERTIGO, FATIGUE, NUMBNESS OF BODY PART" D
46 .S $P(^OOPS(2263.3,13,0),U)="GENERAL SYMPTOMS- SYNCOPE, DIZZINESS, VERTIGO, FATIGUE, NUMBNESS OF BODY PART"
47 .K ^OOPS(2263.3,"B","GENERAL SYMPTOMS: SYNCOPE, DIZZINESS, VERTIGO, FATIGUE, NUMBNESS OF BO",13)
48 .S ^OOPS(2263.3,"B","GENERAL SYMPTOMS- SYNCOPE, DIZZINESS, VERTIGO, FATIGUE, NUMBNESS OF BO",13)=""
49 .K ^OOPS(2263.3,"D","GENERAL SYMPTOMS: SYNCOPE, DIZ",13)
50 .S ^OOPS(2263.3,"D","GENERAL SYMPTOMS- SYNCOPE, DIZ",13)=""
51 I $P(^OOPS(2263.3,68,0),U)="SKIN CONDITIONS: ALLERGY, ECZEMA, DERMATITIS" D
52 .S $P(^OOPS(2263.3,68,0),U)="SKIN CONDITIONS- ALLERGY, ECZEMA, DERMATITIS"
53 .K ^OOPS(2263.3,"B","SKIN CONDITIONS: ALLERGY, ECZEMA, DERMATITIS",68)
54 .S ^OOPS(2263.3,"B","SKIN CONDITIONS- ALLERGY, ECZEMA, DERMATITIS",68)=""
55 .K ^OOPS(2263.3,"D","SKIN CONDITIONS: ALLERGY, ECZE",68)
56 .S ^OOPS(2263.3,"D","SKIN CONDITIONS- ALLERGY, ECZE",68)=""
57 I $P(^OOPS(2263.3,83,0),U)="INFECTIOUS DISEASES: BACTERIA, VIRUSES, PARASITES" D
58 .S $P(^OOPS(2263.3,83,0),U)="INFECTIOUS DISEASES- BACTERIA, VIRUSES, PARASITES"
59 .K ^OOPS(2263.3,"B","INFECTIOUS DISEASES: BACTERIA, VIRUSES, PARASITES",83)
60 .S ^OOPS(2263.3,"B","INFECTIOUS DISEASES- BACTERIA, VIRUSES, PARASITES",83)=""
61 .K ^OOPS(2263.3,"D","INFECTIOUS DISEASES: BACTERIA,",83)
62 .S ^OOPS(2263.3,"D","INFECTIOUS DISEASES- BACTERIA,",83)=""
63 D BMES^XPDUTL("Table updates complete.")
64 Q
65BODYPTS ;
66 N DA,DIK,DIC,DIE,DR,FLG,BODY,BODY1,IEN,STR
67 I $D(^OOPS(2261.1,5,0)) S DA=5,DIK="^OOPS(2261.1," D ^DIK
68 I $$GET1^DIQ(2261.1,101,.01)'="INTESTINES" D
69 .S (DIC,DIE)="^OOPS(2261.1,",DA=101,DR=".01////INTESTINES" D ^DIE
70 ; now make sure no ASISTS Records with a pointer = 5 in field 30, 30.1
71 S IEN=0
72 F S IEN=$O(^OOPS(2260,IEN)) Q:IEN'>0 D
73 .S STR=$G(^OOPS(2260,IEN,"2162B")),FLG=0
74 .I $P($G(STR),U,4)=5 S $P(STR,U,4)=101,FLG=1
75 .I $P($G(STR),U,8)=5 S $P(STR,U,8)=101,FLG=1
76 .I FLG S ^OOPS(2260,IEN,"2162B")=STR
77 Q
Note: See TracBrowser for help on using the repository browser.