| [613] | 1 | OOPSUTL2 ;HINES/WAA-Utilities Routines ;3/24/98 | 
|---|
|  | 2 | ;;2.0;ASISTS;;Jun 03, 2002 | 
|---|
|  | 3 | ;; | 
|---|
|  | 4 | CARE2(IEN) ; Update location field | 
|---|
|  | 5 | N LOC,GEN | 
|---|
|  | 6 | S GEN=$$GET1^DIQ(2260,IEN,27,"I") | 
|---|
|  | 7 | S LOC=$$GET1^DIQ(2261.4,GEN,2,"I") | 
|---|
|  | 8 | S $P(^OOPS(2260,IEN,"2162B"),U,1)=LOC | 
|---|
|  | 9 | Q | 
|---|
|  | 10 | VCHAR ; Write error message if invalid character | 
|---|
|  | 11 | W !,"Invalid character entered (~,`,@,#,$,%,*,_,|,\,},{,[,],>, or <)",!,"please edit.",! | 
|---|
|  | 12 | Q | 
|---|
|  | 13 | DEVSZ(IEN,DEV) ; This screens responses to the DEVICE SIZE table based on whether | 
|---|
|  | 14 | ; the OBJECT CAUSING INJURY field contains the word Needle or Syringe | 
|---|
|  | 15 | ; | 
|---|
|  | 16 | ;  Input:  IEN - Internal Record Number of claim | 
|---|
|  | 17 | ;          DEV - Internal Record Number in ^OOPS(2262.2) | 
|---|
|  | 18 | ; Output: VIEW - if 1, can select, if 0, not available | 
|---|
|  | 19 | ; | 
|---|
|  | 20 | N OBJECT,VIEW | 
|---|
|  | 21 | S VIEW=0 | 
|---|
|  | 22 | S OBJECT=$$UP^OOPSUTL4($$GET1^DIQ(2260,IEN,38)) | 
|---|
|  | 23 | S TYPE=$$GET1^DIQ(2262.2,DEV,1,"I") | 
|---|
|  | 24 | I (OBJECT["NEEDLE")&(TYPE="N"!(TYPE="NS")) S VIEW=1 | 
|---|
|  | 25 | I (OBJECT["SYRINGE")&(TYPE="S"!(TYPE="NS")) S VIEW=1 | 
|---|
|  | 26 | Q VIEW | 
|---|
|  | 27 | EQUIP() ; This will ask if the product failed | 
|---|
|  | 28 | N ANS,DIR,Y | 
|---|
|  | 29 | S ANS=0 | 
|---|
|  | 30 | S DIR(0)="YO^" | 
|---|
|  | 31 | S ANS=0,DIR("B")=$S($P($G(^OOPS(2260,IEN,"2162D")),U,7)'="":"YES",1:"NO") | 
|---|
|  | 32 | S DIR("A")="WAS THERE AN EQUIPMENT/DEVICE/PRODUCT FAILURE" | 
|---|
|  | 33 | S DIR("?")="Enter Yes or No to indicate that it was a failure of an device." | 
|---|
|  | 34 | D ^DIR | 
|---|
|  | 35 | I Y=1 S ANS=1 | 
|---|
|  | 36 | I ANS'=1,$P($G(^OOPS(2260,IEN,"2162D")),U,7)'="" S $P(^("2162D"),U,7)="" | 
|---|
|  | 37 | Q ANS | 
|---|
|  | 38 | DISP ; disp text for prompt | 
|---|
|  | 39 | W !,"Was the exposed part:" | 
|---|
|  | 40 | W !,"      Skin," | 
|---|
|  | 41 | W !,"      Eyes(Conjunctiva)," | 
|---|
|  | 42 | W !,"      Nose(mucosa)," | 
|---|
|  | 43 | W !,"      Mouth(mucosa)" | 
|---|
|  | 44 | W !,"      Other" | 
|---|
|  | 45 | W ! | 
|---|
|  | 46 | Q | 
|---|
|  | 47 | CARE(IEN,GEN) ; Select Patient Care Area | 
|---|
|  | 48 | N AREA,TYPE,VIEW | 
|---|
|  | 49 | S VIEW=0 | 
|---|
|  | 50 | S AREA=$$GET1^DIQ(2260,IEN,26,"I") | 
|---|
|  | 51 | I AREA="" S AREA="U" | 
|---|
|  | 52 | I AREA="U" S VIEW=1 | 
|---|
|  | 53 | E  D | 
|---|
|  | 54 | .S TYPE=$$GET1^DIQ(2261.4,GEN,2,"I") | 
|---|
|  | 55 | .I AREA=TYPE S VIEW=1 | 
|---|
|  | 56 | .Q | 
|---|
|  | 57 | Q VIEW | 
|---|
|  | 58 | ; | 
|---|
|  | 59 | N AREA,OTHER | 
|---|
|  | 60 | N SELECT,DIR,Y,DEFAULT,INC | 
|---|
|  | 61 | S INC=$$GET1^DIQ(2260,IEN,52,"I") | 
|---|
|  | 62 | S SELECT="" | 
|---|
|  | 63 | ;W ! | 
|---|
|  | 64 | ;W !,"  Select the Area Type:",! | 
|---|
|  | 65 | ;W !,"                  1) Patient" | 
|---|
|  | 66 | ;W !,"                  2) Non-patient" | 
|---|
|  | 67 | ;W !,"                  3) Unknown",! | 
|---|
|  | 68 | S DIR(0)="SAO^1:Patient;2:Non-patient;3:Unknown" | 
|---|
|  | 69 | S DIR("A")="GENERAL SETTING OF "_$S(INC=1:"INJURY",INC=2:"ILLNESS",1:"")_": " | 
|---|
|  | 70 | S DIR("?")="Select the area type to be used." | 
|---|
|  | 71 | S SELECT=$$GET1^DIQ(2260,IEN,27,"I") | 
|---|
|  | 72 | S SELECT=$S(SELECT'="":$$GET1^DIQ(2261.4,SELECT,2,"I"),1:"") | 
|---|
|  | 73 | S:SELECT'="" SELECT=$S(SELECT="P":"Patient",SELECT="N":"Non-patient",1:"") | 
|---|
|  | 74 | S:SELECT'="" DIR("B")=SELECT | 
|---|
|  | 75 | D ^DIR | 
|---|
|  | 76 | I $D(DTOUT)!($D(DUOUT)) S Y(0)="",AREA=-1 | 
|---|
|  | 77 | S (OTHER,AREA)=$S(Y(0)="Patient":"P",Y(0)="Non-patient":"N",Y(0)="Unknown":"",1:"-1") | 
|---|
|  | 78 | I AREA'=-1 D | 
|---|
|  | 79 | .I AREA'="",$E(AREA,1)=$E(SELECT,1) S DEFAULT=$$GET1^DIQ(2261.4,$$GET1^DIQ(2260,IEN,27,"I"),.01,"E") | 
|---|
|  | 80 | .D | 
|---|
|  | 81 | ..N DIC,X | 
|---|
|  | 82 | ..S DIC="^OOPS(2261.4," | 
|---|
|  | 83 | ..I AREA'="" S DIC("S")="I $$GET1^DIQ(2261.4,Y,2,""I"")=AREA" | 
|---|
|  | 84 | ..I $D(DEFAULT) S DIC("B")=DEFAULT | 
|---|
|  | 85 | ..S DIC("A")=$S(AREA="P":"PATIENT ",AREA="N":"NON-PATIENT ",1:" ")_"CARE AREA: ",DIC(0)="AQEMNZ" | 
|---|
|  | 86 | ..D ^DIC | 
|---|
|  | 87 | ..I $D(DTOUT)!($D(DUOUT)) S AREA=-1 Q | 
|---|
|  | 88 | ..I Y<1 S AREA=-1 Q | 
|---|
|  | 89 | ..S AREA=$P(Y,U) | 
|---|
|  | 90 | ..Q | 
|---|
|  | 91 | .Q | 
|---|
|  | 92 | I AREA>0 S AREA=AREA_U_OTHER | 
|---|
|  | 93 | Q AREA | 
|---|
|  | 94 | SAFETY(IEN,OPEN) ; Safety Officer Screen | 
|---|
|  | 95 | N VIEW | 
|---|
|  | 96 | S VIEW=0,OPEN=$G(OPEN,0) | 
|---|
|  | 97 | ;I FORM= | 
|---|
|  | 98 | I OPEN,'$P(^OOPS(2260,IEN,0),U,6) S VIEW=1 | 
|---|
|  | 99 | I 'OPEN,$P(^OOPS(2260,IEN,0),U,6)'=2,$P($$EDSTA^OOPSUTL1(IEN,"S"),U,3) S VIEW=1 | 
|---|
|  | 100 | Q VIEW | 
|---|
|  | 101 | SUPSCR(SUP,IEN,OPEN) ; Supervisor screen | 
|---|
|  | 102 | ; Input | 
|---|
|  | 103 | ;   SUP the DUZ of the Supervisor | 
|---|
|  | 104 | ;   IEN the IEN of the ENTRY in file 2260 | 
|---|
|  | 105 | ; | 
|---|
|  | 106 | ; Output | 
|---|
|  | 107 | ;   VIEW 1 Sup can see | 
|---|
|  | 108 | ;        0 Sup can't see | 
|---|
|  | 109 | N VIEW | 
|---|
|  | 110 | S VIEW=0,OPEN=$G(OPEN,0) | 
|---|
|  | 111 | I $$OPEN^OOPSUTL1(IEN,OPEN) D  ;Form can be selected | 
|---|
|  | 112 | .N INJ | 
|---|
|  | 113 | .S INJ=$$GET1^DIQ(2260,IEN,52,"I") | 
|---|
|  | 114 | .I ($$GET1^DIQ(2260,IEN,53,"I")'=DUZ)&($$GET1^DIQ(2260,IEN,53.1,"I")'=DUZ) Q  ; Not the Primary or secondary super | 
|---|
|  | 115 | .I $$EDSTA^OOPSUTL1(IEN,"O") Q | 
|---|
|  | 116 | .;     ^^^ 2162 has been signed by the Safety Officer | 
|---|
|  | 117 | . | 
|---|
|  | 118 | .I ($P($$EDSTA^OOPSUTL1(IEN,"S"),U,INJ)),($P($$EDSTA^OOPSUTL1(IEN,"S"),U,3)) Q  ; Form can not be selected because both | 
|---|
|  | 119 | . ;the 2162 and the CA1/2 have been signed | 
|---|
|  | 120 | .S VIEW=1 | 
|---|
|  | 121 | .Q | 
|---|
|  | 122 | Q VIEW | 
|---|
|  | 123 | AGNINFO ;Patch 7 - default Agency info if available | 
|---|
|  | 124 | S AIEN=$P(^OOPS(2260,IEN,"2162A"),"^",9) | 
|---|
|  | 125 | S AGN=$$GET1^DIQ(4,AIEN,.01,"E") | 
|---|
|  | 126 | S ADD=$$GET1^DIQ(4,AIEN,1.01,"E") | 
|---|
|  | 127 | S CITY=$$GET1^DIQ(4,AIEN,1.03,"E") | 
|---|
|  | 128 | S STATE=$$GET1^DIQ(4,AIEN,.02,"E") | 
|---|
|  | 129 | S ZIP=$$GET1^DIQ(4,AIEN,1.04,"E") | 
|---|
|  | 130 | Q | 
|---|
|  | 131 | PHINFO  ;Patch 7 - default physician data, if available | 
|---|
|  | 132 | S STAT=0 | 
|---|
|  | 133 | S AIEN=$P(^OOPS(2260,IEN,"2162A"),"^",9) | 
|---|
|  | 134 | ; get physician data for correct STATION | 
|---|
|  | 135 | F  S STAT=$O(^OOPS(2262,1,1,STAT)) Q:STAT'>0  I ($P(^OOPS(2262,1,1,STAT,0),"^")=AIEN) Q  ;found match, quit | 
|---|
|  | 136 | I STAT D | 
|---|
|  | 137 | .S SIEN=STAT_",1," | 
|---|
|  | 138 | .S PNAME=$$GET1^DIQ(2262.03,SIEN,1) | 
|---|
|  | 139 | .S PADD=$$GET1^DIQ(2262.03,SIEN,2) | 
|---|
|  | 140 | .S PCITY=$$GET1^DIQ(2262.03,SIEN,3) | 
|---|
|  | 141 | .S PSTATE=$$GET1^DIQ(2262.03,SIEN,4) | 
|---|
|  | 142 | .S PZIP=$$GET1^DIQ(2262.03,SIEN,5) | 
|---|
|  | 143 | .S PTITLE=$$GET1^DIQ(2262.03,SIEN,"6:1") | 
|---|
|  | 144 | Q | 
|---|
|  | 145 | RWS ;Regular Work Schedule | 
|---|
|  | 146 | N Y S DIR(0)="LA^1:7" | 
|---|
|  | 147 | S DIR("?",1)="     Enter the employee's work schedule at the time of the incident." | 
|---|
|  | 148 | S DIR("?",2)="     The numbers 1-7 correspond to the days of the week." | 
|---|
|  | 149 | S DIR("?",3)="       1 = Sunday" | 
|---|
|  | 150 | S DIR("?",4)="       2 = Monday" | 
|---|
|  | 151 | S DIR("?",5)="       3 = Tuesday" | 
|---|
|  | 152 | S DIR("?",6)="       4 = Wednesday" | 
|---|
|  | 153 | S DIR("?",7)="       5 = Thursday" | 
|---|
|  | 154 | S DIR("?",8)="       6 = Friday" | 
|---|
|  | 155 | S DIR("?",9)="       7 = Saturday" | 
|---|
|  | 156 | S DIR("?",10)="     Enter the day numbers as a range or list separated by commas." | 
|---|
|  | 157 | S DIR("?",11)="" | 
|---|
|  | 158 | S DIR("?",12)="     Examples: For Mon-Fri     enter 2-6 (or 2,3,4,5,6)" | 
|---|
|  | 159 | S DIR("?",13)="               For Wed-Sat     enter 4-7 (or 4,5,6,7)" | 
|---|
|  | 160 | S DIR("?")="               For Mon,Wed,Fri enter 2,4,6" | 
|---|
|  | 161 | D ^DIR | 
|---|
|  | 162 | I $P(X,"-",2)>7 W !,"     Range exceeds 1-7 limit." G RWS | 
|---|
|  | 163 | Q:$D(DIRUT) | 
|---|
|  | 164 | S:ITEM=21 $P(^OOPS(2260,D0,"CA1F"),U,11)=Y | 
|---|
|  | 165 | S:ITEM=22 $P(^OOPS(2260,D0,"CA2I"),U,8)=Y | 
|---|
|  | 166 | Q | 
|---|
|  | 167 | EXCEPT ; Exception statement | 
|---|
|  | 168 | W !," ",ITEM,". A supervisor who knowingly certifies to any false statement," | 
|---|
|  | 169 | W !,"     misrepresentation, concealment of fact, etc., in respect of" | 
|---|
|  | 170 | W !,"     this claim may also be subject to appropriate felony criminal" | 
|---|
|  | 171 | W !,"     prosecution." | 
|---|
|  | 172 | W ! | 
|---|
|  | 173 | W !,"     I certify that the information given above and that furnished" | 
|---|
|  | 174 | W !,"     by the employee is true to the best of my knowledge with the" | 
|---|
|  | 175 | W !,"     following exception." | 
|---|
|  | 176 | W ! | 
|---|
|  | 177 | Q | 
|---|
|  | 178 | MKNUM(INSTR) ; Strip/Convert num numerics from a string - Patch 11 | 
|---|
|  | 179 | ;   Input  - INSTR  - Character String that should be a number | 
|---|
|  | 180 | ;  Output  - NUMOUT - String stripped of all non-numeric characters. | 
|---|
|  | 181 | N K,NUMOUT | 
|---|
|  | 182 | S NUMOUT="" | 
|---|
|  | 183 | F K=1:1:$L(INSTR) I ($A(INSTR,K)>47)&($A(INSTR,K)<58) S NUMOUT=NUMOUT_$E(INSTR,K) | 
|---|
|  | 184 | Q NUMOUT | 
|---|
|  | 185 | RWSOT ;Regular Work Schedule output transform | 
|---|
|  | 186 | N I,HOLD | 
|---|
|  | 187 | S HOLD="" | 
|---|
|  | 188 | F I=1:1:($L(Y)/2) S HOLD=HOLD_$P("Sun,Mon,Tue,Wed,Thu,Fri,Sat",",",$P(Y,",",I))_"," | 
|---|
|  | 189 | S Y=$E(HOLD,1,($L(HOLD)-1)) | 
|---|
|  | 190 | Q | 
|---|
|  | 191 | UNION(IEN) ; | 
|---|
|  | 192 | ; Input: IEN   = Internal Entry Number of entry in file 2260 | 
|---|
|  | 193 | ; Output VALID = 1 Valid to be seen by Union | 
|---|
|  | 194 | ;              = 0 Not Valid to be seen by Union | 
|---|
|  | 195 | N VALID | 
|---|
|  | 196 | S VALID=0 | 
|---|
|  | 197 | I $$EDSTA^OOPSUTL1(IEN,"O"),$P($$EDSTA^OOPSUTL1(IEN,"S"),U,3) S VALID=1 | 
|---|
|  | 198 | Q VALID | 
|---|