| 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
 | 
|---|