OOPSPRT ;HIRMFO/GWB-Print Report of Accident ;3/5/98
;;2.0;ASISTS;;Jun 03, 2002
SUP S DIC="^OOPS(2260,"
S DIC("S")="I $$GET1^DIQ(2260,Y,53,""I"")=DUZ!($$GET1^DIQ(2260,Y,53.1,""I"")=DUZ)"
G DIC
SO S DIC="^OOPS(2260,"
DIC S DIC(0)="AEMNZ",DIC("A")="Select case: "
D ^DIC Q:(Y<1)!($D(DTOUT))!($D(DUOUT))
S IEN=+Y
K IOP,%ZIS S %ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP KILL
I $D(IO("Q")) S OOPSLST="IEN^UNION" D TASK G KILL
U IO D PRT D ^%ZISC K %ZIS,IOP G KILL
PRT N LIN,SUP,AETBF,CAT,PPE,INCID
S PG=0,EX="",LIN=$S(($E(IOST,1,2)="C-"):IOSL-2,1:IOSL-6),IE=IEN
D NOW^%DTC S DATE=%,Y=DATE X ^DD("DD") S DATE=$P(Y,":",1,2)
K DIQ,DA,DR S DIC="^OOPS(2260,",DR=".01:99",DA=IEN,DIQ="OOPS" D EN^DIQ1
I $D(^OOPS(2260,IEN,"2162E")) S EIEN=0 F S EIEN=$O(^OOPS(2260,IEN,"2162E",EIEN)) Q:EIEN="" K DIQ S DIC="^OOPS(2260,",DR=39,DA=IEN,DIQ="OOPS",DR(2260.039)=.01,DA(2260.039)=EIEN D EN^DIQ1
I $D(^OOPS(2260,IEN,"2162F")) S FIEN=0 F S FIEN=$O(^OOPS(2260,IEN,"2162F",FIEN)) Q:FIEN="" K DIQ S DIC="^OOPS(2260,",DR=40,DA=IEN,DIQ="OOPS",DR(2260.01)=.01,DA(2260.01)=FIEN D EN^DIQ1
S CN=OOPS(2260,IEN,.01)
S TOI=OOPS(2260,IEN,3)
; Patch 5 - have changed this logic, matches other routines
S CAT=$$GET1^DIQ(2260,IEN,2,"I")
S SUP=$S((CAT=1!(CAT>6)):"SUPERVISOR...................:",CAT=2:"VOLUNTARY SVC SUPERVISOR.....:",CAT=3:"CONTRACT ADMINISTRATOR.......:",1:"SAFETY OFFICER...............:")
D HDR
W !,"CASE NUMBER..................: ",OOPS(2260,IEN,.01) D P Q:EX=U
W !,"PERSONNEL STATUS.............: ",OOPS(2260,IEN,2) D P Q:EX=U
W !,"SERVICE......................: ",OOPS(2260,IEN,86) D P Q:EX=U
W !,"TYPE OF INCIDENT.............: ",OOPS(2260,IEN,3) D P Q:EX=U
W !,"CASE STATUS..................: ",OOPS(2260,IEN,51) D P Q:EX=U
W !,"INJURY/ILLNESS...............: ",OOPS(2260,IEN,52) D P Q:EX=U
; Patch 5 - added the block structure
I $G(UNION)'="Y" D Q:EX=U
. W !,"PERSON INVOLVED..............: ",OOPS(2260,IEN,1) D P Q:EX=U
. W !,"SSN..........................: ",OOPS(2260,IEN,5) D P Q:EX=U
. W !,"DATE OF BIRTH................: ",OOPS(2260,IEN,6) D P Q:EX=U
. W !,"SEX..........................: ",OOPS(2260,IEN,7) D P Q:EX=U
. W !,"HOME ADDRESS.................: ",OOPS(2260,IEN,8) D P Q:EX=U
. I (OOPS(2260,IEN,9)'="")!(OOPS(2260,IEN,10)'="")!(OOPS(2260,IEN,11)'="") W !," ",OOPS(2260,IEN,9),", ",OOPS(2260,IEN,10)," ",OOPS(2260,IEN,11) D P Q:EX=U
. W !,"HOME PHONE NUMBER............: ",OOPS(2260,IEN,12) D P Q:EX=U
. ; Patch 5 - print station #
. W !,"STATION NUMBER...............: ",OOPS(2260,IEN,13) D P Q:EX=U
. W !,"COST CENTER/ORG..............: ",OOPS(2260,IEN,14) D P Q:EX=U
. W !,"OCCUPATION...................: ",OOPS(2260,IEN,15) D P Q:EX=U
. W !,"GRADE/STEP...................: ",OOPS(2260,IEN,16) W:OOPS(2260,IEN,16)'="" "/" W OOPS(2260,IEN,17) D P Q:EX=U
. W !,"EDUCATION....................: ",OOPS(2260,IEN,18) D P Q:EX=U
. W !,SUP," ",OOPS(2260,IEN,53) D P Q:EX=U
. W !,"SECONDARY SUPERVISOR.........: ",OOPS(2260,IEN,53.1) D P Q:EX=U
; Patch 5 - new logic for Station Number display
I $G(UNION)="Y" D Q:EX=U
. W !,"STATION NUMBER...............: ",OOPS(2260,IEN,13) D P Q:EX=U
W !,"DATE/TIME OF OCCURRENCE......: ",OOPS(2260,IEN,4) D P Q:EX=U
W !,"GENERAL SETTING OF INCIDENT..: ",OOPS(2260,IEN,26) D P Q:EX=U
W !,"LOCATION OF INCIDENT.........: ",OOPS(2260,IEN,27) D P Q:EX=U
W !,"CHARACTERIZATION OF INJURY...: ",OOPS(2260,IEN,29) D P Q:EX=U
; Patch 5 - added write
W !,"MEDICAL EMERGENCY............: ",OOPS(2260,IEN,29.5) D P Q:EX=U
W !,"BODY PART MOST AFFECTED......: ",OOPS(2260,IEN,30) D P Q:EX=U
W !,"ADDITIONAL BODY PART AFFECTED: ",OOPS(2260,IEN,30.1) D P Q:EX=U
W !,"SIDE OF BODY AFFECTED........: ",OOPS(2260,IEN,31) D P Q:EX=U
W !,"DUTY RETURNED TO.............: ",OOPS(2260,IEN,32) D P Q:EX=U
W !,"LOST TIME....................: ",OOPS(2260,IEN,33) D P Q:EX=U
W !,"DESCRIPTION OF INCIDENT......:"
S DOI=0 F S DOI=$O(OOPS(2260,IEN,28,DOI)) Q:DOI="" W !," ",OOPS(2260,IEN,28,DOI) D P Q:EX=U
; Patch 11 - set INCID and use rather than global hit
S INCID=$P(^OOPS(2260,IEN,0),U,4)
I INCID>10 D Q:EX=U
.W !,"PATIENT SOURCE...............: ",OOPS(2260,IEN,34) D P Q:EX=U
I (INCID=11)!(INCID=12)!(INCID=14) D
.W !,"CONTAMINATION................: ",OOPS(2260,IEN,35) D P Q:EX=U
.W !,"PURPOSE OF SHARP OBJECT......: ",OOPS(2260,IEN,36) D P Q:EX=U
.W !,"ACTIVITY AT TIME OF INJURY...: ",OOPS(2260,IEN,37) D P Q:EX=U
.W !,"OBJECT CAUSING INJURY........: ",OOPS(2260,IEN,38) D P Q:EX=U
.I OOPS(2260,IEN,83)'="" D
..W !,"DEVICE SIZE..................: ",OOPS(2260,IEN,83) D P Q:EX=U
.W !,"BRAND........................: ",OOPS(2260,IEN,82) D P Q:EX=U
I INCID=13 D Q:EX=U
.W !,"AREA EXPOSED TO BODILY FLUID.: "
.K IND S AETBF=0 F S AETBF=$O(OOPS(2260.039,AETBF)) Q:AETBF="" W ?31,OOPS(2260.039,AETBF,.01),! S IND="" D P Q:EX=U
.W:'$D(IND) ! W "PERSONAL PROTECTIVE EQUIPMENT: " K IND
.K IND S PPE=0 F S PPE=$O(OOPS(2260.01,PPE)) Q:PPE="" W ?31,OOPS(2260.01,PPE,.01),! S IND="" D P Q:EX=U
.W:'$D(IND) ! W "BODILY FLUID EXPOSURE SOURCE.: ",OOPS(2260,IEN,41) K IND D P Q:EX=U
I INCID>10 D Q:EX=U
.; Patch 5 - added If
.I OOPS(2260,IEN,42.5)="Yes" D Q:EX=U
..W !,"EQUIPMENT/DEVICE FAILURE.....: ",OOPS(2260,IEN,42) D P Q:EX=U
.W !,"SAFETY DESIGN DEVICE USED....: ",OOPS(2260,IEN,43) D P Q:EX=U
.I (OOPS(2260,IEN,43)="Yes") D
.. W !,"DID INJURY OCCUR BEFORE"
.. W !," SAFETY DEVICE WAS ENGAGED...: ",OOPS(2260,IEN,87) D P Q:EX=U
.. W !,"SAFETY CHARACTERISTICS.......: ",OOPS(2260,IEN,84) D P Q:EX=U
.W:(OOPS(2260,IEN,43)="No") !,"EXPLAIN WHY SAFE DEV NOT USED: ",OOPS(2260,IEN,85) D P Q:EX=U
W !,"CORRECTIVE ACTION............: "
S OPFLD=47 D WP K OPFLD
W !,"SAFETY OFF. COMMENTS.........: "
S OPFLD=55 D WP K OPFLD
W !,"PERSON ENTERING STUB RECORD..: ",OOPS(2260,IEN,56) D P Q:EX=U
I $G(UNION)'="Y" W !,"/ES/SUPERVISOR...............: ",OOPS(2260,IEN,44) D P Q:EX=U
W !,"SUPERVISOR SIGNATURE DATE....: ",OOPS(2260,IEN,46) D P Q:EX=U
W !,"/ES/SAFETY OFFICER...........: ",OOPS(2260,IEN,48) D P Q:EX=U
W !,"SAFETY OFFICER SIGNATURE DATE: ",OOPS(2260,IEN,50) D P Q:EX=U
I $E(IOST,1,2)="C-" W ! K DIR S DIR(0)="E" D ^DIR W @IOF
KILL ;Kill Variables and Exit
K %,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
K CA,CACNT,CN,D0,DA,DASHES,DATE,DIC,DIQ,DIQ2,DOI,DR,EIEN,EX,FIEN,I,IE
K IEN,OOPS,PG,TOI,SUP,UNION
Q
P ;Print
I ($Y'<(LIN-3)) D Q:EX=U
.I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
.D HDR Q
Q
TASK ;Queue a task
K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
S ZTRTN="PRT^OOPSPRT",ZTREQ="@",ZTSAVE("ZTREQ")=""
S ZTDESC="ASISTS REPORT OF ACCIDENT"
F V2=1:1 S V1=$P(OOPSLST,"^",V2) Q:V1="" S ZTSAVE(V1)=""
D ^%ZTLOAD D ^%ZISC U IO W !,"Request Queued",!
K V1,V2,OOPSLST,ZTSK Q
WP ; Process Word Processing Fields (#47, #55)
N DIWL,DIWR,DIWF,OPGLB,OPI,OPNODE,OPT,OPC
K ^UTILITY($J,"W")
S DIWL=1,DIWR="",DIWF="|C76"
S OPNODE=$P($$GET1^DID(2260,OPFLD,"","GLOBAL SUBSCRIPT LOCATION"),";")
S OPI=0 F S OPI=$O(^OOPS(2260,IEN,OPNODE,OPI)) Q:'OPI S X=$G(^OOPS(2260,IEN,OPNODE,OPI,0)) D:X]"" ^DIWP
S OPT=$G(^UTILITY($J,"W",1))+0
I OPT S OPI=0 F OPC=1:1 S OPI=$O(^UTILITY($J,"W",1,OPI)) Q:'OPI!(EX=U) D
. W !?1,^UTILITY($J,"W",1,OPI,0) D P Q:EX=U
K ^UTILITY($J,"W"),X
Q
HDR ;Header
W @IOF S PG=PG+1 K DASHES S $P(DASHES,"-",80)="-"
W !,"Report of Accident ",CN,?73,"Page ",PG
;W ?62,ONDATE,!,DASHES
W !,DASHES
Q
UNION ; Union Entry point
S UNION="Y"
S DIC="^OOPS(2260,"
S DIC("S")="I $$UNION^OOPSUTL2(Y)"
G DIC
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSPRT 7609 printed Apr 09, 2024@20:45:08 Page 2
OOPSPRT ;HIRMFO/GWB-Print Report of Accident ;3/5/98
+1 ;;2.0;ASISTS;;Jun 03, 2002
SUP SET DIC="^OOPS(2260,"
+1 SET DIC("S")="I $$GET1^DIQ(2260,Y,53,""I"")=DUZ!($$GET1^DIQ(2260,Y,53.1,""I"")=DUZ)"
+2 GOTO DIC
SO SET DIC="^OOPS(2260,"
DIC SET DIC(0)="AEMNZ"
SET DIC("A")="Select case: "
+1 DO ^DIC
if (Y<1)!($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+2 SET IEN=+Y
+3 KILL IOP,%ZIS
SET %ZIS="MQ"
WRITE !
DO ^%ZIS
KILL %ZIS,IOP
if POP
GOTO KILL
+4 IF $DATA(IO("Q"))
SET OOPSLST="IEN^UNION"
DO TASK
GOTO KILL
+5 USE IO
DO PRT
DO ^%ZISC
KILL %ZIS,IOP
GOTO KILL
PRT NEW LIN,SUP,AETBF,CAT,PPE,INCID
+1 SET PG=0
SET EX=""
SET LIN=$SELECT(($EXTRACT(IOST,1,2)="C-"):IOSL-2,1:IOSL-6)
SET IE=IEN
+2 DO NOW^%DTC
SET DATE=%
SET Y=DATE
XECUTE ^DD("DD")
SET DATE=$PIECE(Y,":",1,2)
+3 KILL DIQ,DA,DR
SET DIC="^OOPS(2260,"
SET DR=".01:99"
SET DA=IEN
SET DIQ="OOPS"
DO EN^DIQ1
+4 IF $DATA(^OOPS(2260,IEN,"2162E"))
SET EIEN=0
FOR
SET EIEN=$ORDER(^OOPS(2260,IEN,"2162E",EIEN))
if EIEN=""
QUIT
KILL DIQ
SET DIC="^OOPS(2260,"
SET DR=39
SET DA=IEN
SET DIQ="OOPS"
SET DR(2260.039)=.01
SET DA(2260.039)=EIEN
DO EN^DIQ1
+5 IF $DATA(^OOPS(2260,IEN,"2162F"))
SET FIEN=0
FOR
SET FIEN=$ORDER(^OOPS(2260,IEN,"2162F",FIEN))
if FIEN=""
QUIT
KILL DIQ
SET DIC="^OOPS(2260,"
SET DR=40
SET DA=IEN
SET DIQ="OOPS"
SET DR(2260.01)=.01
SET DA(2260.01)=FIEN
DO EN^DIQ1
+6 SET CN=OOPS(2260,IEN,.01)
+7 SET TOI=OOPS(2260,IEN,3)
+8 ; Patch 5 - have changed this logic, matches other routines
+9 SET CAT=$$GET1^DIQ(2260,IEN,2,"I")
+10 SET SUP=$SELECT((CAT=1!(CAT>6)):"SUPERVISOR...................:",CAT=2:"VOLUNTARY SVC SUPERVISOR.....:",CAT=3:"CONTRACT ADMINISTRATOR.......:",1:"SAFETY OFFICER...............:")
+11 DO HDR
+12 WRITE !,"CASE NUMBER..................: ",OOPS(2260,IEN,.01)
DO P
if EX=U
QUIT
+13 WRITE !,"PERSONNEL STATUS.............: ",OOPS(2260,IEN,2)
DO P
if EX=U
QUIT
+14 WRITE !,"SERVICE......................: ",OOPS(2260,IEN,86)
DO P
if EX=U
QUIT
+15 WRITE !,"TYPE OF INCIDENT.............: ",OOPS(2260,IEN,3)
DO P
if EX=U
QUIT
+16 WRITE !,"CASE STATUS..................: ",OOPS(2260,IEN,51)
DO P
if EX=U
QUIT
+17 WRITE !,"INJURY/ILLNESS...............: ",OOPS(2260,IEN,52)
DO P
if EX=U
QUIT
+18 ; Patch 5 - added the block structure
+19 IF $GET(UNION)'="Y"
Begin DoDot:1
+20 WRITE !,"PERSON INVOLVED..............: ",OOPS(2260,IEN,1)
DO P
if EX=U
QUIT
+21 WRITE !,"SSN..........................: ",OOPS(2260,IEN,5)
DO P
if EX=U
QUIT
+22 WRITE !,"DATE OF BIRTH................: ",OOPS(2260,IEN,6)
DO P
if EX=U
QUIT
+23 WRITE !,"SEX..........................: ",OOPS(2260,IEN,7)
DO P
if EX=U
QUIT
+24 WRITE !,"HOME ADDRESS.................: ",OOPS(2260,IEN,8)
DO P
if EX=U
QUIT
+25 IF (OOPS(2260,IEN,9)'="")!(OOPS(2260,IEN,10)'="")!(OOPS(2260,IEN,11)'="")
WRITE !," ",OOPS(2260,IEN,9),", ",OOPS(2260,IEN,10)," ",OOPS(2260,IEN,11)
DO P
if EX=U
QUIT
+26 WRITE !,"HOME PHONE NUMBER............: ",OOPS(2260,IEN,12)
DO P
if EX=U
QUIT
+27 ; Patch 5 - print station #
+28 WRITE !,"STATION NUMBER...............: ",OOPS(2260,IEN,13)
DO P
if EX=U
QUIT
+29 WRITE !,"COST CENTER/ORG..............: ",OOPS(2260,IEN,14)
DO P
if EX=U
QUIT
+30 WRITE !,"OCCUPATION...................: ",OOPS(2260,IEN,15)
DO P
if EX=U
QUIT
+31 WRITE !,"GRADE/STEP...................: ",OOPS(2260,IEN,16)
if OOPS(2260,IEN,16)'=""
WRITE "/"
WRITE OOPS(2260,IEN,17)
DO P
if EX=U
QUIT
+32 WRITE !,"EDUCATION....................: ",OOPS(2260,IEN,18)
DO P
if EX=U
QUIT
+33 WRITE !,SUP," ",OOPS(2260,IEN,53)
DO P
if EX=U
QUIT
+34 WRITE !,"SECONDARY SUPERVISOR.........: ",OOPS(2260,IEN,53.1)
DO P
if EX=U
QUIT
End DoDot:1
if EX=U
QUIT
+35 ; Patch 5 - new logic for Station Number display
+36 IF $GET(UNION)="Y"
Begin DoDot:1
+37 WRITE !,"STATION NUMBER...............: ",OOPS(2260,IEN,13)
DO P
if EX=U
QUIT
End DoDot:1
if EX=U
QUIT
+38 WRITE !,"DATE/TIME OF OCCURRENCE......: ",OOPS(2260,IEN,4)
DO P
if EX=U
QUIT
+39 WRITE !,"GENERAL SETTING OF INCIDENT..: ",OOPS(2260,IEN,26)
DO P
if EX=U
QUIT
+40 WRITE !,"LOCATION OF INCIDENT.........: ",OOPS(2260,IEN,27)
DO P
if EX=U
QUIT
+41 WRITE !,"CHARACTERIZATION OF INJURY...: ",OOPS(2260,IEN,29)
DO P
if EX=U
QUIT
+42 ; Patch 5 - added write
+43 WRITE !,"MEDICAL EMERGENCY............: ",OOPS(2260,IEN,29.5)
DO P
if EX=U
QUIT
+44 WRITE !,"BODY PART MOST AFFECTED......: ",OOPS(2260,IEN,30)
DO P
if EX=U
QUIT
+45 WRITE !,"ADDITIONAL BODY PART AFFECTED: ",OOPS(2260,IEN,30.1)
DO P
if EX=U
QUIT
+46 WRITE !,"SIDE OF BODY AFFECTED........: ",OOPS(2260,IEN,31)
DO P
if EX=U
QUIT
+47 WRITE !,"DUTY RETURNED TO.............: ",OOPS(2260,IEN,32)
DO P
if EX=U
QUIT
+48 WRITE !,"LOST TIME....................: ",OOPS(2260,IEN,33)
DO P
if EX=U
QUIT
+49 WRITE !,"DESCRIPTION OF INCIDENT......:"
+50 SET DOI=0
FOR
SET DOI=$ORDER(OOPS(2260,IEN,28,DOI))
if DOI=""
QUIT
WRITE !," ",OOPS(2260,IEN,28,DOI)
DO P
if EX=U
QUIT
+51 ; Patch 11 - set INCID and use rather than global hit
+52 SET INCID=$PIECE(^OOPS(2260,IEN,0),U,4)
+53 IF INCID>10
Begin DoDot:1
+54 WRITE !,"PATIENT SOURCE...............: ",OOPS(2260,IEN,34)
DO P
if EX=U
QUIT
End DoDot:1
if EX=U
QUIT
+55 IF (INCID=11)!(INCID=12)!(INCID=14)
Begin DoDot:1
+56 WRITE !,"CONTAMINATION................: ",OOPS(2260,IEN,35)
DO P
if EX=U
QUIT
+57 WRITE !,"PURPOSE OF SHARP OBJECT......: ",OOPS(2260,IEN,36)
DO P
if EX=U
QUIT
+58 WRITE !,"ACTIVITY AT TIME OF INJURY...: ",OOPS(2260,IEN,37)
DO P
if EX=U
QUIT
+59 WRITE !,"OBJECT CAUSING INJURY........: ",OOPS(2260,IEN,38)
DO P
if EX=U
QUIT
+60 IF OOPS(2260,IEN,83)'=""
Begin DoDot:2
+61 WRITE !,"DEVICE SIZE..................: ",OOPS(2260,IEN,83)
DO P
if EX=U
QUIT
End DoDot:2
+62 WRITE !,"BRAND........................: ",OOPS(2260,IEN,82)
DO P
if EX=U
QUIT
End DoDot:1
+63 IF INCID=13
Begin DoDot:1
+64 WRITE !,"AREA EXPOSED TO BODILY FLUID.: "
+65 KILL IND
SET AETBF=0
FOR
SET AETBF=$ORDER(OOPS(2260.039,AETBF))
if AETBF=""
QUIT
WRITE ?31,OOPS(2260.039,AETBF,.01),!
SET IND=""
DO P
if EX=U
QUIT
+66 if '$DATA(IND)
WRITE !
WRITE "PERSONAL PROTECTIVE EQUIPMENT: "
KILL IND
+67 KILL IND
SET PPE=0
FOR
SET PPE=$ORDER(OOPS(2260.01,PPE))
if PPE=""
QUIT
WRITE ?31,OOPS(2260.01,PPE,.01),!
SET IND=""
DO P
if EX=U
QUIT
+68 if '$DATA(IND)
WRITE !
WRITE "BODILY FLUID EXPOSURE SOURCE.: ",OOPS(2260,IEN,41)
KILL IND
DO P
if EX=U
QUIT
End DoDot:1
if EX=U
QUIT
+69 IF INCID>10
Begin DoDot:1
+70 ; Patch 5 - added If
+71 IF OOPS(2260,IEN,42.5)="Yes"
Begin DoDot:2
+72 WRITE !,"EQUIPMENT/DEVICE FAILURE.....: ",OOPS(2260,IEN,42)
DO P
if EX=U
QUIT
End DoDot:2
if EX=U
QUIT
+73 WRITE !,"SAFETY DESIGN DEVICE USED....: ",OOPS(2260,IEN,43)
DO P
if EX=U
QUIT
+74 IF (OOPS(2260,IEN,43)="Yes")
Begin DoDot:2
+75 WRITE !,"DID INJURY OCCUR BEFORE"
+76 WRITE !," SAFETY DEVICE WAS ENGAGED...: ",OOPS(2260,IEN,87)
DO P
if EX=U
QUIT
+77 WRITE !,"SAFETY CHARACTERISTICS.......: ",OOPS(2260,IEN,84)
DO P
if EX=U
QUIT
End DoDot:2
+78 if (OOPS(2260,IEN,43)="No")
WRITE !,"EXPLAIN WHY SAFE DEV NOT USED: ",OOPS(2260,IEN,85)
DO P
if EX=U
QUIT
End DoDot:1
if EX=U
QUIT
+79 WRITE !,"CORRECTIVE ACTION............: "
+80 SET OPFLD=47
DO WP
KILL OPFLD
+81 WRITE !,"SAFETY OFF. COMMENTS.........: "
+82 SET OPFLD=55
DO WP
KILL OPFLD
+83 WRITE !,"PERSON ENTERING STUB RECORD..: ",OOPS(2260,IEN,56)
DO P
if EX=U
QUIT
+84 IF $GET(UNION)'="Y"
WRITE !,"/ES/SUPERVISOR...............: ",OOPS(2260,IEN,44)
DO P
if EX=U
QUIT
+85 WRITE !,"SUPERVISOR SIGNATURE DATE....: ",OOPS(2260,IEN,46)
DO P
if EX=U
QUIT
+86 WRITE !,"/ES/SAFETY OFFICER...........: ",OOPS(2260,IEN,48)
DO P
if EX=U
QUIT
+87 WRITE !,"SAFETY OFFICER SIGNATURE DATE: ",OOPS(2260,IEN,50)
DO P
if EX=U
QUIT
+88 IF $EXTRACT(IOST,1,2)="C-"
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
WRITE @IOF
KILL ;Kill Variables and Exit
+1 KILL %,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 KILL CA,CACNT,CN,D0,DA,DASHES,DATE,DIC,DIQ,DIQ2,DOI,DR,EIEN,EX,FIEN,I,IE
+3 KILL IEN,OOPS,PG,TOI,SUP,UNION
+4 QUIT
P ;Print
+1 IF ($Y'<(LIN-3))
Begin DoDot:1
+2 IF IOST?1"C".E
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF 'Y
SET EX=U
QUIT
+3 DO HDR
QUIT
End DoDot:1
if EX=U
QUIT
+4 QUIT
TASK ;Queue a task
+1 KILL IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
+2 SET ZTRTN="PRT^OOPSPRT"
SET ZTREQ="@"
SET ZTSAVE("ZTREQ")=""
+3 SET ZTDESC="ASISTS REPORT OF ACCIDENT"
+4 FOR V2=1:1
SET V1=$PIECE(OOPSLST,"^",V2)
if V1=""
QUIT
SET ZTSAVE(V1)=""
+5 DO ^%ZTLOAD
DO ^%ZISC
USE IO
WRITE !,"Request Queued",!
+6 KILL V1,V2,OOPSLST,ZTSK
QUIT
WP ; Process Word Processing Fields (#47, #55)
+1 NEW DIWL,DIWR,DIWF,OPGLB,OPI,OPNODE,OPT,OPC
+2 KILL ^UTILITY($JOB,"W")
+3 SET DIWL=1
SET DIWR=""
SET DIWF="|C76"
+4 SET OPNODE=$PIECE($$GET1^DID(2260,OPFLD,"","GLOBAL SUBSCRIPT LOCATION"),";")
+5 SET OPI=0
FOR
SET OPI=$ORDER(^OOPS(2260,IEN,OPNODE,OPI))
if 'OPI
QUIT
SET X=$GET(^OOPS(2260,IEN,OPNODE,OPI,0))
if X]""
DO ^DIWP
+6 SET OPT=$GET(^UTILITY($JOB,"W",1))+0
+7 IF OPT
SET OPI=0
FOR OPC=1:1
SET OPI=$ORDER(^UTILITY($JOB,"W",1,OPI))
if 'OPI!(EX=U)
QUIT
Begin DoDot:1
+8 WRITE !?1,^UTILITY($JOB,"W",1,OPI,0)
DO P
if EX=U
QUIT
End DoDot:1
+9 KILL ^UTILITY($JOB,"W"),X
+10 QUIT
HDR ;Header
+1 WRITE @IOF
SET PG=PG+1
KILL DASHES
SET $PIECE(DASHES,"-",80)="-"
+2 WRITE !,"Report of Accident ",CN,?73,"Page ",PG
+3 ;W ?62,ONDATE,!,DASHES
+4 WRITE !,DASHES
+5 QUIT
UNION ; Union Entry point
+1 SET UNION="Y"
+2 SET DIC="^OOPS(2260,"
+3 SET DIC("S")="I $$UNION^OOPSUTL2(Y)"
+4 GOTO DIC
