source: WorldVistAEHR/trunk/r/ASISTS-OOPS/OOPSPRT.m@ 901

Last change on this file since 901 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 7.3 KB
Line 
1OOPSPRT ;HIRMFO/GWB-Print Report of Accident ;3/5/98
2 ;;2.0;ASISTS;;Jun 03, 2002
3SUP S DIC="^OOPS(2260,"
4 S DIC("S")="I $$GET1^DIQ(2260,Y,53,""I"")=DUZ!($$GET1^DIQ(2260,Y,53.1,""I"")=DUZ)"
5 G DIC
6SO S DIC="^OOPS(2260,"
7DIC S DIC(0)="AEMNZ",DIC("A")="Select case: "
8 D ^DIC Q:(Y<1)!($D(DTOUT))!($D(DUOUT))
9 S IEN=+Y
10 K IOP,%ZIS S %ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP KILL
11 I $D(IO("Q")) S OOPSLST="IEN^UNION" D TASK G KILL
12 U IO D PRT D ^%ZISC K %ZIS,IOP G KILL
13PRT N LIN,SUP,AETBF,CAT,PPE,INCID
14 S PG=0,EX="",LIN=$S(($E(IOST,1,2)="C-"):IOSL-2,1:IOSL-6),IE=IEN
15 D NOW^%DTC S DATE=%,Y=DATE X ^DD("DD") S DATE=$P(Y,":",1,2)
16 K DIQ,DA,DR S DIC="^OOPS(2260,",DR=".01:99",DA=IEN,DIQ="OOPS" D EN^DIQ1
17 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
18 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
19 S CN=OOPS(2260,IEN,.01)
20 S TOI=OOPS(2260,IEN,3)
21 ; Patch 5 - have changed this logic, matches other routines
22 S CAT=$$GET1^DIQ(2260,IEN,2,"I")
23 S SUP=$S((CAT=1!(CAT>6)):"SUPERVISOR...................:",CAT=2:"VOLUNTARY SVC SUPERVISOR.....:",CAT=3:"CONTRACT ADMINISTRATOR.......:",1:"SAFETY OFFICER...............:")
24 D HDR
25 W !,"CASE NUMBER..................: ",OOPS(2260,IEN,.01) D P Q:EX=U
26 W !,"PERSONNEL STATUS.............: ",OOPS(2260,IEN,2) D P Q:EX=U
27 W !,"SERVICE......................: ",OOPS(2260,IEN,86) D P Q:EX=U
28 W !,"TYPE OF INCIDENT.............: ",OOPS(2260,IEN,3) D P Q:EX=U
29 W !,"CASE STATUS..................: ",OOPS(2260,IEN,51) D P Q:EX=U
30 W !,"INJURY/ILLNESS...............: ",OOPS(2260,IEN,52) D P Q:EX=U
31 ; Patch 5 - added the block structure
32 I $G(UNION)'="Y" D Q:EX=U
33 . W !,"PERSON INVOLVED..............: ",OOPS(2260,IEN,1) D P Q:EX=U
34 . W !,"SSN..........................: ",OOPS(2260,IEN,5) D P Q:EX=U
35 . W !,"DATE OF BIRTH................: ",OOPS(2260,IEN,6) D P Q:EX=U
36 . W !,"SEX..........................: ",OOPS(2260,IEN,7) D P Q:EX=U
37 . W !,"HOME ADDRESS.................: ",OOPS(2260,IEN,8) D P Q:EX=U
38 . 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
39 . W !,"HOME PHONE NUMBER............: ",OOPS(2260,IEN,12) D P Q:EX=U
40 . ; Patch 5 - print station #
41 . W !,"STATION NUMBER...............: ",OOPS(2260,IEN,13) D P Q:EX=U
42 . W !,"COST CENTER/ORG..............: ",OOPS(2260,IEN,14) D P Q:EX=U
43 . W !,"OCCUPATION...................: ",OOPS(2260,IEN,15) D P Q:EX=U
44 . W !,"GRADE/STEP...................: ",OOPS(2260,IEN,16) W:OOPS(2260,IEN,16)'="" "/" W OOPS(2260,IEN,17) D P Q:EX=U
45 . W !,"EDUCATION....................: ",OOPS(2260,IEN,18) D P Q:EX=U
46 . W !,SUP," ",OOPS(2260,IEN,53) D P Q:EX=U
47 . W !,"SECONDARY SUPERVISOR.........: ",OOPS(2260,IEN,53.1) D P Q:EX=U
48 ; Patch 5 - new logic for Station Number display
49 I $G(UNION)="Y" D Q:EX=U
50 . W !,"STATION NUMBER...............: ",OOPS(2260,IEN,13) D P Q:EX=U
51 W !,"DATE/TIME OF OCCURRENCE......: ",OOPS(2260,IEN,4) D P Q:EX=U
52 W !,"GENERAL SETTING OF INCIDENT..: ",OOPS(2260,IEN,26) D P Q:EX=U
53 W !,"LOCATION OF INCIDENT.........: ",OOPS(2260,IEN,27) D P Q:EX=U
54 W !,"CHARACTERIZATION OF INJURY...: ",OOPS(2260,IEN,29) D P Q:EX=U
55 ; Patch 5 - added write
56 W !,"MEDICAL EMERGENCY............: ",OOPS(2260,IEN,29.5) D P Q:EX=U
57 W !,"BODY PART MOST AFFECTED......: ",OOPS(2260,IEN,30) D P Q:EX=U
58 W !,"ADDITIONAL BODY PART AFFECTED: ",OOPS(2260,IEN,30.1) D P Q:EX=U
59 W !,"SIDE OF BODY AFFECTED........: ",OOPS(2260,IEN,31) D P Q:EX=U
60 W !,"DUTY RETURNED TO.............: ",OOPS(2260,IEN,32) D P Q:EX=U
61 W !,"LOST TIME....................: ",OOPS(2260,IEN,33) D P Q:EX=U
62 W !,"DESCRIPTION OF INCIDENT......:"
63 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
64 ; Patch 11 - set INCID and use rather than global hit
65 S INCID=$P(^OOPS(2260,IEN,0),U,4)
66 I INCID>10 D Q:EX=U
67 .W !,"PATIENT SOURCE...............: ",OOPS(2260,IEN,34) D P Q:EX=U
68 I (INCID=11)!(INCID=12)!(INCID=14) D
69 .W !,"CONTAMINATION................: ",OOPS(2260,IEN,35) D P Q:EX=U
70 .W !,"PURPOSE OF SHARP OBJECT......: ",OOPS(2260,IEN,36) D P Q:EX=U
71 .W !,"ACTIVITY AT TIME OF INJURY...: ",OOPS(2260,IEN,37) D P Q:EX=U
72 .W !,"OBJECT CAUSING INJURY........: ",OOPS(2260,IEN,38) D P Q:EX=U
73 .I OOPS(2260,IEN,83)'="" D
74 ..W !,"DEVICE SIZE..................: ",OOPS(2260,IEN,83) D P Q:EX=U
75 .W !,"BRAND........................: ",OOPS(2260,IEN,82) D P Q:EX=U
76 I INCID=13 D Q:EX=U
77 .W !,"AREA EXPOSED TO BODILY FLUID.: "
78 .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
79 .W:'$D(IND) ! W "PERSONAL PROTECTIVE EQUIPMENT: " K IND
80 .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
81 .W:'$D(IND) ! W "BODILY FLUID EXPOSURE SOURCE.: ",OOPS(2260,IEN,41) K IND D P Q:EX=U
82 I INCID>10 D Q:EX=U
83 .; Patch 5 - added If
84 .I OOPS(2260,IEN,42.5)="Yes" D Q:EX=U
85 ..W !,"EQUIPMENT/DEVICE FAILURE.....: ",OOPS(2260,IEN,42) D P Q:EX=U
86 .W !,"SAFETY DESIGN DEVICE USED....: ",OOPS(2260,IEN,43) D P Q:EX=U
87 .I (OOPS(2260,IEN,43)="Yes") D
88 .. W !,"DID INJURY OCCUR BEFORE"
89 .. W !," SAFETY DEVICE WAS ENGAGED...: ",OOPS(2260,IEN,87) D P Q:EX=U
90 .. W !,"SAFETY CHARACTERISTICS.......: ",OOPS(2260,IEN,84) D P Q:EX=U
91 .W:(OOPS(2260,IEN,43)="No") !,"EXPLAIN WHY SAFE DEV NOT USED: ",OOPS(2260,IEN,85) D P Q:EX=U
92 W !,"CORRECTIVE ACTION............: "
93 S OPFLD=47 D WP K OPFLD
94 W !,"SAFETY OFF. COMMENTS.........: "
95 S OPFLD=55 D WP K OPFLD
96 W !,"PERSON ENTERING STUB RECORD..: ",OOPS(2260,IEN,56) D P Q:EX=U
97 I $G(UNION)'="Y" W !,"/ES/SUPERVISOR...............: ",OOPS(2260,IEN,44) D P Q:EX=U
98 W !,"SUPERVISOR SIGNATURE DATE....: ",OOPS(2260,IEN,46) D P Q:EX=U
99 W !,"/ES/SAFETY OFFICER...........: ",OOPS(2260,IEN,48) D P Q:EX=U
100 W !,"SAFETY OFFICER SIGNATURE DATE: ",OOPS(2260,IEN,50) D P Q:EX=U
101 I $E(IOST,1,2)="C-" W ! K DIR S DIR(0)="E" D ^DIR W @IOF
102KILL ;Kill Variables and Exit
103 K %,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
104 K CA,CACNT,CN,D0,DA,DASHES,DATE,DIC,DIQ,DIQ2,DOI,DR,EIEN,EX,FIEN,I,IE
105 K IEN,OOPS,PG,TOI,SUP,UNION
106 Q
107P ;Print
108 I ($Y'<(LIN-3)) D Q:EX=U
109 .I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
110 .D HDR Q
111 Q
112TASK ;Queue a task
113 K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
114 S ZTRTN="PRT^OOPSPRT",ZTREQ="@",ZTSAVE("ZTREQ")=""
115 S ZTDESC="ASISTS REPORT OF ACCIDENT"
116 F V2=1:1 S V1=$P(OOPSLST,"^",V2) Q:V1="" S ZTSAVE(V1)=""
117 D ^%ZTLOAD D ^%ZISC U IO W !,"Request Queued",!
118 K V1,V2,OOPSLST,ZTSK Q
119WP ; Process Word Processing Fields (#47, #55)
120 N DIWL,DIWR,DIWF,OPGLB,OPI,OPNODE,OPT,OPC
121 K ^UTILITY($J,"W")
122 S DIWL=1,DIWR="",DIWF="|C76"
123 S OPNODE=$P($$GET1^DID(2260,OPFLD,"","GLOBAL SUBSCRIPT LOCATION"),";")
124 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
125 S OPT=$G(^UTILITY($J,"W",1))+0
126 I OPT S OPI=0 F OPC=1:1 S OPI=$O(^UTILITY($J,"W",1,OPI)) Q:'OPI!(EX=U) D
127 . W !?1,^UTILITY($J,"W",1,OPI,0) D P Q:EX=U
128 K ^UTILITY($J,"W"),X
129 Q
130HDR ;Header
131 W @IOF S PG=PG+1 K DASHES S $P(DASHES,"-",80)="-"
132 W !,"Report of Accident ",CN,?73,"Page ",PG
133 ;W ?62,ONDATE,!,DASHES
134 W !,DASHES
135 Q
136UNION ; Union Entry point
137 S UNION="Y"
138 S DIC="^OOPS(2260,"
139 S DIC("S")="I $$UNION^OOPSUTL2(Y)"
140 G DIC
Note: See TracBrowser for help on using the repository browser.