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