- 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 Jan 18, 2025@02:40:48 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