VistA-WorldVistAEHR/r/INCIDENT_REPORTING-QAN/QANPSD1.m

64 lines
4.1 KiB
Mathematica

QANPSD1 ;HISC/GJC-Pseudo VA 10-2633 ;10/1/92
;;2.0;Incident Reporting;**1,16**;08/07/1992
;
W !?5,"PATIENT: ",$G(QANAME),?45,"PATIENT ID: ",$G(QANPID)
W !?5,"SOCIAL SECURITY NUMBER: ",$G(QANSSN),?45,"AGE: ",$G(QANAGE)
W !?5,"DATE/TIME INCIDENT: ",$G(QANDATE),?45,"DATE INITIATED: ",$G(QANINIT)
W !?5,"WARD/CLINIC: ",$G(QANWARD),?45,"SERVICE: ",$G(QANSERV)
I 'QANBLNK,($D(^QA(742,QANDFN,2,0))) W !?5,"CLINICAL DIAGNOSIS: " S (QAN,QANFLAG)=0 F S QAN=$O(^QA(742,QANDFN,2,QAN)) Q:QAN'>0 D DIAG Q:QANFIN["^"
I QANBLNK W !?5,"CLINICAL DIAGNOSIS: ",!!!!!
S QANFLAG=0 Q:QANFIN["^"
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !!?5,"ADMISSION DATE: ",$G(QANADMT),?45,"INCIDENT TYPE: ",$G(QANINCD)
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !?5,"WITNESS: ",$G(QANWIT) W:$G(QANWIT)["Y" ?45,"RELATIONSHIP TO PATIENT: __________"
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !?5,"INCIDENT LOCATION: ",$G(QANILOC),?45,"CASE NUMBER: ",$G(QANCASE)
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^"
I 'QANBLNK,($D(^QA(742.4,QANIEN,1,0))) W !!?5,"INCIDENT DESCRIPTION: " S (QAN,QANFLAG)=0 F S QAN=$O(^QA(742.4,QANIEN,1,QAN)) Q:QAN'>0 D DESCR Q:QANFIN["^"
I QANBLNK W !!?5,"INCIDENT DESCRIPTION: ",!!
S QANFLAG=0 Q:QANFIN["^"
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !!!?5,"SIGNATURE AND TITLE OF REPORTER: _________________________",!
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W ?5,"DATE: __________",!
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !?5,"PHYSICIAN'S EXAMINATION FINDINGS/ACTIONS:",!!!!!
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !?10,"SEVERITY LEVEL: 0 1 2 3"
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !!?10,"EXAMINING PHYSICIAN'S SIGNATURE: _________________________",!?10,"DATE: __________",!
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !?5,"SERVICE LEVEL FINDINGS/ACTIONS:",!!!
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !?10,"SIGNATURE: _________________________",!?10,"DATE: __________",!!
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W $G(QANEQ),!
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !?5,"CHIEF OF STAFF REVIEW:",!!?5,"INCIDENT TYPE: ",$G(QANINCD)
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^"
I 'QANBLNK,($D(^QA(742,QANDFN,1,0))) W !?5,"RESPONSIBLE SERVICE: " S (QAN,QANFLAG)=0 F S QAN=$O(^QA(742,QANDFN,1,QAN)) Q:QAN'>0 D RSERV Q:QANFIN["^"
I QANBLNK W !?5,"RESPONSIBLE SERVICE: "
S QANFLAG=0 Q:QANFIN["^"
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !!?5,"COMMENTS: ",!!!
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !?5,"RECOMMENDATIONS FOR FURTHER FOLLOW-UP: ",!?10,"NO",!?10,"YES",!
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !?10,"SPECIFY:",!!!
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !?10,"COS SIGNATURE: _________________________",!?10,"DATE: __________"
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !!,$G(QANEQ),!!?5,"DIRECTOR'S REVIEW:",!!
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !?5,"ACTION TAKEN BY MEDICAL CENTER:",?45,"NEED FOR FURTHER REVIEW:"
I 'QANBLNK,($D(^QA(742.4,QANIEN,2,0))) S (QAN,QAN(0),QANFLAG)=0 F S QAN=$O(^QA(742.4,QANIEN,2,QAN)) Q:QAN'>0 D MEDC Q:QANFIN["^"
S QANFLAG=0 Q:QANFIN["^"
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^"
I 'QANBLNK,('$D(^QA(742.4,QANIEN,2,0))) W !?45,$G(QANLREV)
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !!!?5,"DIRECTOR'S SIGNATURE: _________________________",!
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W ?5,"DATE: __________",!
Q
DESCR ;Incident Description word processing
S X=$G(^QA(742.4,QANIEN,1,QAN,0)),DIWF="",DIWR=50,DIWL=10,QANFLAG=1
K ^UTILITY($J,"W") D ^DIWP
S QANMN=0,QANLBL="INCIDENT DESCRIPTION: "
F S QANMN=+$O(^UTILITY($J,"W",DIWL,QANMN)) Q:QANMN'>0 D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !?15,^(QANMN,0)
Q
RSERV ;Responsible Service multiple
S QANLBL="RESPONSIBLE SERVICE: ",QANFLAG=1
S Y=$P(^QA(742,QANDFN,1,QAN,0),U),C=$P(^DD(742.01,.01,0),U,2) D:Y]"" Y^DIQ
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !?15,Y
Q
DIAG ;Patient Diagnosis multiple
S QANLBL="CLINICAL DIAGNOSIS: ",QANFLAG=1
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !?15,$P(^QA(742,QANDFN,2,QAN,0),U)
Q
MEDC ;Medical Center Action multiple
S QAN(0)=QAN(0)+1,QANLBL="ACTION TAKEN BY MEDICAL CENTER: ",QANFLAG=1
S Y=$P(^QA(742.4,QANIEN,2,QAN,0),U),C=$P(^DD(742.42,.01,0),U,2) D:Y]"" Y^DIQ
D:$Y>(IOSL-8) HDH^QANPSDO Q:QANFIN["^" W !?10,Y W:QAN(0)=1 ?45,$G(QANLREV)
Q