source: FOIAVistA/trunk/r/ASISTS-OOPS/OOPSCC.m@ 681

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

initial load of FOIAVistA 6/30/08 version
File size: 7.4 KB
Line 
1OOPSCC ;HINES CIOFO/GWB-CREATE ASISTS CASE ;3/5/98
2 ;;2.0;ASISTS;;Jun 03, 2002
3 N CAT,DATE,SUP,FYEAR,GRP,I,IEN2260,OOPS,IEN450,EMP,IEN200,PAID,VIEW
4 N DLAYGO
5 S DIE("NO^")="BACKOUTOK",VIEW=0
6 D NOW^%DTC
7 S DATE=X,FYEAR="",FYEAR=$$FYEAR^OOPSCSN(X),NUM=$$NEWR^OOPSCSN(FYEAR)
8 S (NAME,SEX,SSN,DOB,STN,CCT,OCC,GRD,STP,EDU,ANS,PAID)=""
9 W @IOF
10 W !!," Case number ",NUM," will be assigned to this incident.",!
11 K DD,DO
12 S DLAYGO=2260,DIC="^OOPS(2260,",DIC(0)="QLZ",X=NUM D FILE^DICN G:Y=-1 EXIT
13 S IEN2260=+Y
14PS K DR S DIE="^OOPS(2260,",DA=IEN2260,DR="2 PERSONNEL STATUS........."
15 D ^DIE
16 G:$D(Y)'=0 DELETE S CAT=X
17 I CAT=1 D G:Y=-1 DELETE ; Employee in ^PRSPC (PAID)
18 .S DIC="^PRSPC(",DIC("A")=" PERSON INVOLVED..........: ",DIC("B")=NAME
19 .S DIC("W")="W ?30,$E($P(^(0),U,9),6,9)"
20 .S DIC(0)="QEAMZ" D ^DIC Q:Y=-1
21 .S IEN450=+Y,NAME=$P(Y,U,2)
22 .N Y K DIQ S DIC="^PRSPC(",DR="6;8;10;13;16;31;32;38;458;604",DA=IEN450
23 .S DIQ="OOPS",DIQ(0)="IE" D EN^DIQ1
24 .S STN=OOPS(450,IEN450,6,"I")
25 .S SSN=OOPS(450,IEN450,8,"I")
26 .S EDU=OOPS(450,IEN450,10,"E"),EDU=$E(EDU,1)_$$LOW^XLFSTR($E(EDU,2,45))
27 .S GRD=OOPS(450,IEN450,13,"I")
28 .S OCC=OOPS(450,IEN450,16,"I")
29 .S CCT=OOPS(450,IEN450,458,"I")
30 .S SEX=OOPS(450,IEN450,31,"I")
31 .S DOB=OOPS(450,IEN450,32,"I")
32 .S STP=OOPS(450,IEN450,38,"I")
33 ;
34 ; New Personnel Status = Non-Paid Employee. Get fields from ^VA(200
35 ; If Person in PAID file (PAID=1) don't allow adding as non-paid emp
36 ; If no SSN in file 200, set PAID=1, prevent hard errors
37 I CAT=6 D G:(Y=-1!(PAID)) DELETE
38 .S DIC="^VA(200,",DIC("A")=" PERSON INVOLVED..........: ",DIC("B")=NAME
39 .S DIC("W")="W ?30,$E($P(^(1),U,9),6,9)"
40 .S DIC(0)="QEAMZ" D ^DIC Q:Y=-1
41 .S IEN200=+Y,NAME=$P(Y,U,2)
42 .; Make sure the person is not a PAID Employee - Patch 3
43 .S PAID=0
44 .; If no SSN, Can't continue - Patch 3
45 .I '$$GET1^DIQ(200,IEN200,9,"I") D Q
46 ..W !,"No SSN on file in the New Person file. Must enter to create case."
47 ..S PAID=1
48 .N Y K DIQ S DIC="^VA(200,",DR="4;5;9",DA=IEN200
49 .S DIQ="OOPS",DIQ(0)="IE" D EN^DIQ1
50 .S SEX=OOPS(200,IEN200,4,"I")
51 .S DOB=OOPS(200,IEN200,5,"I")
52 .S SSN=OOPS(200,IEN200,9,"I")
53 .I $D(^PRSPC("SSN",SSN)) D
54 ..W !,"This person (SSN) is a 'PAID' Employee, Please Re-enter"
55 ..S PAID=1
56 K DR S DIE="^OOPS(2260,",DA=IEN2260,DR=""
57 I CAT=1 D ; Employee in ^PRSPC (PAID)
58 .S DR(1,2260,1)="1///^S X=NAME"
59 .S DR(1,2260,2)="5///^S X=SSN"
60 .S DR(1,2260,3)="6///^S X=DOB"
61 .S DR(1,2260,4)="7///^S X=SEX"
62 .S DR(1,2260,5)="14///^S X=CCT"
63 .S DR(1,2260,6)="15///^S X=$E(OCC,1,4)"
64 .S DR(1,2260,7)="16///^S X=GRD"
65 .S DR(1,2260,8)="17///^S X=STP"
66 .S DR(1,2260,9)="18///^S X=EDU"
67 I CAT=6 D ; Employee not in ^PRSPC (Non-PAID)
68 .S DR(1,2260,1)="1///^S X=NAME"
69 .S DR(1,2260,2)="5///^S X=SSN"
70 .S DR(1,2260,3)="6///^S X=DOB"
71 .S DR(1,2260,4)="7///^S X=SEX"
72 I CAT'=1&(CAT'=6) D ; Everyone else
73 .S DR(1,2260,1)="1 PERSON INVOLVED.........."
74 .S DR(1,2260,2)="5 SSN......................"
75 .; Patch 5 - get data for non-employee personnel
76 . S DR(1,2260,3)="I X="""" W !,""Social Security Number is Required"" S Y=5"
77 .S DR(1,2260,4)="6 DOB......................"
78 .S DR(1,2260,5)="I X="""" W !,""Date of Birth is required"" S Y=6"
79 .S DR(1,2260,6)="7 SEX......................"
80 .S DR(1,2260,7)="I X="""" W !,""Sex is Required"" S Y=7"
81 ;
82 ; Patch 5 - Check for Duplicate Cases
83 S DR(1,2260,10)="I $$DUP^OOPSCC() S Y=""@3"""
84 S DR(1,2260,15)="8 HOME STREET ADDRESS......"
85 S DR(1,2260,16)="I X'="""",'$$VCHAR^OOPSUTL4(X) W !,""Invalid character entered, (~,`,@,#,$,%,*,_,|,\,},{,[,],>, or <),"",!,""please edit."",! S Y=8"
86 S DR(1,2260,20)="9 CITY....................."
87 S DR(1,2260,21)="I X'="""",'$$VCHAR^OOPSUTL4(X) W !,""Invalid character entered, (~,`,@,#,$,%,*,_,|,\,},{,[,],>, or <),"",!,""please edit."",! S Y=9"
88 S DR(1,2260,25)="10 STATE...................."
89 S DR(1,2260,30)="11 ZIP CODE................."
90 S DR(1,2260,35)="12 HOME PHONE NUMBER........"
91 ; Patch 8 - add error checking on phone for DOL requirements
92 S DR(1,2260,40)="I $TR(X,""/-*#"","""")'?10N W !?3,""Phone number must include area code and 7 digits only. Example 703-123-8789"" S Y=12"
93 ; Patch 5 - Collect Station Number for everyone, allow changing PAID
94 S DR(1,2260,45)="13 STATION NUMBER...........//^S X=STN"
95 S DR(1,2260,50)="52 INJURY/ILLNESS..........."
96 S DR(1,2260,51)="S Y=$S(X=1:""@1"",1:""@2"")"
97 S DR(1,2260,52)="@1"
98 S DR(1,2260,55)="4 DATE/TIME INJURY OCCURRED"
99 S DR(1,2260,56)="I $P(X,""."",2)="""" W !,""Time is REQUIRED in this response."" S Y=4"
100 S DR(1,2260,57)="S Y=3"
101 S DR(1,2260,58)="@2"
102 S DR(1,2260,60)="4 DATE 1ST AWARE OF ILLNESS"
103 S DR(1,2260,65)="3 TYPE OF INCIDENT........."
104 ; patch 5 - changed for new category types
105 S SUP=$S((CAT=1!(CAT>6)):" SUPERVISOR...............",CAT=2:" VOLUNTARY SVC SUPERVISOR.",CAT=3:" CONTRACT ADMINISTRATOR...",1:" SAFETY OFFICER...........")
106 S DR(1,2260,70)="53"_SUP
107 S DR(1,2260,75)="53.1 SECONDARY SUPERVISOR....."
108 S DR(1,2260,76)="56////^S X=DUZ"
109 ; Since the AAC is requiring an Occupation code for volunteers
110 ; it will be hard coded if the CAT=2 (Volunteer) so claim will not
111 ; reject at the AAC (WCMIS)
112 I CAT=2 S DR(1,2260,80)="15////^S X=9999"
113 S DR(1,2260,85)="@3"
114 S DR(1,2260,90)="I VIEW W !!?4,""This Case will be DELETED!"""
115 D ^DIE G:$D(Y)'=0!(VIEW) DELETE ; VIEW = Duplicate Patch 5
116 S DIR(0)="S^E:Edit;S:Save;D:Delete",DIR("A")=" Case action" D ^DIR K DIR
117 I Y="E" S ANS="E" G PS
118 I Y="S" D D CASE^OOPSMBUL(IEN2260) D:((CAT=1)!(CAT=6))&(SSN'="") BOR^OOPSMBUL(IEN2260):$D(^VA(200,"SSN",SSN)) G EXIT
119 .K DR S DIE="^OOPS(2260,",DA=IEN2260,DR="51///0" D ^DIE K DIE
120 .W !!," Case number ",NUM," has been saved.",!
121 I (Y="D")!($D(DIRUT)) G DELETE
122 G EXIT
123DUP() ; Patch 5 Finds Open Cases w/Matching names, Cases checked for
124 ; being a duplicate must have a Status of OPEN
125 ;
126 ; Input Variables:
127 ; IEN2260 - IEN of Current Case
128 ; SSN - SSN of Current Case
129 ; Output Variables
130 ; VIEW - returns 1 if user indicates case is a duplicate
131 ; which triggers system to delete the case and exit
132 ; - returns 0 if user indicates case is not a duplicate
133 ; and system continues normal processing.
134 ;
135 N ARR,FILE,FLD,IX,SCR,SSN,STR,X,Y
136 S FILE=2260,FLD=5
137 S SSN=$$GET1^DIQ(2260,IEN2260,5,"I")
138 S IX="SSN",ARR="OOPS",VIEW=0
139 S SCR="I ($$GET1^DIQ(FILE,Y,51,""I"")<1)&(Y'=IEN2260)"
140 S SCR=SCR_"&($$GET1^DIQ(FILE,Y,5,""I"")=SSN)"
141 D LIST^DIC(FILE,,FLD,,,,,IX,SCR,,ARR)
142 I $G(OOPS("DILIST",0)) D
143 .W !!,"The following case(s) are Open with SSN: "_SSN,!
144 .N DIC,DA,DR,OPID,Y
145 .S DIC="^OOPS(2260,",(DA,DR,OPID)=0
146 .F S OPID=$O(OOPS("DILIST",2,OPID)) Q:OPID="" D
147 ..S DA=OOPS("DILIST",2,OPID),STR=^OOPS(2260,DA,0) D
148 ...W !?2,"CASE NUMBER: ",$P(STR,U),?40,"PERSON INVOLVED: ",$E($P(STR,U,2),1,25)
149 ...W !?2,"PERSONNEL STATUS:",$$GET1^DIQ(FILE,DA,2,"E"),?40,"PAY PLAN: ",$P(STR,U,13)
150 ...W !?2,"TYPE OF INCIDENT: ",$$GET1^DIQ(FILE,DA,3,"E")
151 ...W !?2,"DATE/TIME OF OCCURRENCE: ",$$GET1^DIQ(FILE,DA,4,"E")
152 ...W !?2,"CASE STATUS: ",$$GET1^DIQ(FILE,DA,51,"E")
153 ...W ?40,"INJURY/ILLNESS: ",$$GET1^DIQ(FILE,DA,52,"E")
154 ...W !?2,"SUPERVISOR: ",$$GET1^DIQ(FILE,DA,53,"E")
155 ...W !?2,"PERSON ENTERING STUB RECORD: ",$$GET1^DIQ(FILE,DA,56,"E"),!
156 . K DIR S DIR(0)="Y"
157 . S DIR("A")=" Is the Current entry a DUPLICATE Case: "
158 . D ^DIR K DIR
159 . I Y S VIEW=1
160 Q VIEW
161DELETE ;Delete incomplete case
162 S DIK="^OOPS(2260,",DA=IEN2260 D ^DIK K DIK
163END W !!," Case ",NUM," deleted"
164EXIT K DA,DIC,DIE,DR,NUM,NAME,SEX,SSN,DOB,STN,CCT,OCC,GRD,STP,EDU,ANS
165 Q
Note: See TracBrowser for help on using the repository browser.