Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: OOPSPRT

OOPSPRT.m

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