1 | QAOSPHDR ;HISC/DAD-GENERAL WORKSHEET HEADER ;2/4/93 09:42
|
---|
2 | ;;3.0;Occurrence Screen;;09/14/1993
|
---|
3 | ; QAOSD0 = IEN OF RECORD IN FILE# 741
|
---|
4 | ; QAOSREVR = REVIEW LEVEL # ^ SPECIFIC REVIEWER ^ REVIEW DATE
|
---|
5 | ; (NOTE: ALL PIECES SHOULD BE IN EXTERNAL FORMAT)
|
---|
6 | S LOC=+$O(^QA(741.2,"C",+QAOSREVR,0)),LOC=$P($G(^QA(741.2,+LOC,0)),"^")
|
---|
7 | S:$D(QAOSPAGE)[0 QAOSPAGE=1 S HEADER=LOC_" REVIEW WORKSHEET"
|
---|
8 | I +QAOSREVR=1,QAOSHOW'=3,$D(^QA(740,1,"OS"))#2,$P(^("OS"),"^",3) S HEADER=HEADER_" (PART 2)"
|
---|
9 | S Y=DT X ^DD("DD")
|
---|
10 | W:(QAOSPAGE>1)!($E(IOST)="C") @IOF
|
---|
11 | W !!?80-$L(HEADER)/2,HEADER
|
---|
12 | I QAOSHOW'=3 W ?68,Y,!?68,"PAGE: ",QAOSPAGE
|
---|
13 | E W ?68,"PAGE: ",QAOSPAGE
|
---|
14 | D EN6^QAQAUTL
|
---|
15 | S LOCQA=$G(^QA(741,QAOSD0,0)),QAOSDFN=+LOCQA,SCRN=+$G(^("SCRN"))
|
---|
16 | S (Y,QAOSWHEN)=$P(LOCQA,"^",3) X ^DD("DD")
|
---|
17 | S LOCDPT=$G(^DPT(+LOCQA,0)),NAME=$P(LOCDPT,"^"),SSN=$P(LOCDPT,"^",9)
|
---|
18 | S SCRN=$G(^QA(741.1,SCRN,0)),SCREEN=$P(SCRN,"^",2),SCRN=+SCRN
|
---|
19 | K UNSC S $P(UNSC,"_",31)=""
|
---|
20 | W !,"PATIENT: ",$S(NAME="":UNSC,1:NAME)
|
---|
21 | W ?41,"SSN: ",$S(SSN="":$E(UNSC,1,10),1:SSN)
|
---|
22 | W ?57,"DATE: ",$S(Y="":$E(UNSC,1,17),1:Y)
|
---|
23 | I SCRN W !,SCRN,?10,SCREEN
|
---|
24 | E W !!,"SCREEN: ",UNSC,UNSC,$E(UNSC,1,10)
|
---|
25 | G:QAOSPAGE>1 UNDL
|
---|
26 | S X=+QAOSREVR,REVR=$S(X=1:"CLIN REV",X=2:"PEER REV",X=3:"MGMT REV",X=4:"CMTE REV",X=5:"VAL/CONF",1:"REVIEWER")
|
---|
27 | S LOC=$P(QAOSREVR,"^",2) W !!,REVR,": ",$S(LOC="":UNSC,1:LOC)
|
---|
28 | W ?41,"REVW DT: ",$S($P(QAOSREVR,"^",3)]"":$P(QAOSREVR,"^",3),1:UNSC)
|
---|
29 | S IEN405=+$P(LOCQA,"^",2),LOC405=$G(^DGPM(IEN405,0))
|
---|
30 | S LOC=$P(LOCQA,"^",5)
|
---|
31 | W !!,"WARD: ",$S(LOC="":UNSC,$D(^SC(LOC,0))#2:$P(^(0),"^"),1:LOC)
|
---|
32 | S LOC=$P(LOCQA,"^",6)
|
---|
33 | W ?41,"SERVICE: ",$S(LOC="":UNSC,$D(^DIC(49,LOC,0))#2:$P(^(0),"^"),1:LOC)
|
---|
34 | S LOC=$P(LOCQA,"^",7)
|
---|
35 | W !!,"TR SPEC: ",$S(LOC="":UNSC,$D(^DIC(45.7,LOC,0))#2:$P(^(0),"^"),1:LOC)
|
---|
36 | S LOC=$P(LOCQA,"^",8)
|
---|
37 | W ?41,"MED TM: ",$S(LOC="":UNSC,$D(^QA(741.93,LOC,0))#2:$P(^(0),"^"),1:LOC)
|
---|
38 | S LOC=$P(LOCQA,"^",9)
|
---|
39 | W !!,"ATTEND: ",$S(LOC="":UNSC,$D(^VA(200,LOC,0))#2:$P(^(0),"^"),1:LOC)
|
---|
40 | S LOC=$P(LOCQA,"^",10)
|
---|
41 | W ?41,"RES/PRV: ",$S(LOC="":UNSC,$D(^VA(200,LOC,0))#2:$P(^(0),"^"),1:LOC)
|
---|
42 | S Y=$P(LOC405,"^") X ^DD("DD") W !!,"ADM DATE: ",$S(Y="":UNSC,1:Y)
|
---|
43 | S LOC=$P(LOC405,"^",10) W ?41,"ADM DXS: ",$S(LOC="":UNSC,1:LOC)
|
---|
44 | S LOC=$P($G(^DIC(42,+$P(LOC405,"^",6),0)),"^")
|
---|
45 | W !!,"ADM WARD: ",$S(LOC="":UNSC,1:LOC)
|
---|
46 | S LOC=$S($G(^DPT(+LOCQA,.1))]"":^(.1),1:UNSC)
|
---|
47 | W ?41,"CUR WRD: ",$S(LOC="":UNSC,1:LOC)
|
---|
48 | D 101:SCRN\1=101,106:SCRN\1=106,109:SCRN=109
|
---|
49 | UNDL K UNDL S $P(UNDL,"=",80)="=",QAOSPAGE=QAOSPAGE+1 W !,UNDL
|
---|
50 | Q
|
---|
51 | 101 ;
|
---|
52 | S QA=+$P($G(^QA(741,QAOSD0,0)),"^",2),QA=$P($G(^DGPM(QA,0)),"^")
|
---|
53 | S QA=+$O(^DGPM("ATID3",QAOSDFN,9999999.9999999-QA))
|
---|
54 | S QA=+$O(^DGPM("ATID3",QAOSDFN,QA,0)),(Y,SRV)=""
|
---|
55 | I QA D
|
---|
56 | . K VAIP S DFN=QAOSDFN,VAIP("E")=QA D IN5^VADPT
|
---|
57 | . S Y=$P(VAIP(3),"^",2),SRV=+VAIP(8),SRV=+$P($G(^DIC(45.7,SRV,0)),"^",4)
|
---|
58 | . S SRV=$P($G(^DIC(49,SRV,0)),"^") K VAIP
|
---|
59 | W !!,"D/C DATE: ",$S(Y="":UNSC,1:Y)
|
---|
60 | W ?41,"D/C SRV: ",$S(SRV="":UNSC,1:SRV)
|
---|
61 | Q
|
---|
62 | 106 ;
|
---|
63 | S SRV=+$P($G(^QA(741,QAOSD0,0)),"^",6),SRV=$P($G(^DIC(49,SRV,0)),"^")
|
---|
64 | W !!,"ORG SRV: ",$S(SRV="":UNSC,1:SRV)
|
---|
65 | Q
|
---|
66 | 109 ;
|
---|
67 | W !!,"AUTOPSY REQUESTED ( Y / N )",?41,"PERFORMED ( Y / N ) CIRCLE 'Y' OR 'N'"
|
---|
68 | Q
|
---|