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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANPSD1 4300 printed Oct 16, 2024@18:00:42 Page 2
QANPSD1 ;HISC/GJC-Pseudo VA 10-2633 ;10/1/92
+1 ;;2.0;Incident Reporting;**1,16**;08/07/1992
+2 ;
+3 WRITE !?5,"PATIENT: ",$GET(QANAME),?45,"PATIENT ID: ",$GET(QANPID)
+4 WRITE !?5,"SOCIAL SECURITY NUMBER: ",$GET(QANSSN),?45,"AGE: ",$GET(QANAGE)
+5 WRITE !?5,"DATE/TIME INCIDENT: ",$GET(QANDATE),?45,"DATE INITIATED: ",$GET(QANINIT)
+6 WRITE !?5,"WARD/CLINIC: ",$GET(QANWARD),?45,"SERVICE: ",$GET(QANSERV)
+7 IF 'QANBLNK
IF ($DATA(^QA(742,QANDFN,2,0)))
WRITE !?5,"CLINICAL DIAGNOSIS: "
SET (QAN,QANFLAG)=0
FOR
SET QAN=$ORDER(^QA(742,QANDFN,2,QAN))
if QAN'>0
QUIT
DO DIAG
if QANFIN["^"
QUIT
+8 IF QANBLNK
WRITE !?5,"CLINICAL DIAGNOSIS: ",!!!!!
+9 SET QANFLAG=0
if QANFIN["^"
QUIT
+10 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !!?5,"ADMISSION DATE: ",$GET(QANADMT),?45,"INCIDENT TYPE: ",$GET(QANINCD)
+11 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !?5,"WITNESS: ",$GET(QANWIT)
if $GET(QANWIT)["Y"
WRITE ?45,"RELATIONSHIP TO PATIENT: __________"
+12 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !?5,"INCIDENT LOCATION: ",$GET(QANILOC),?45,"CASE NUMBER: ",$GET(QANCASE)
+13 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
+14 IF 'QANBLNK
IF ($DATA(^QA(742.4,QANIEN,1,0)))
WRITE !!?5,"INCIDENT DESCRIPTION: "
SET (QAN,QANFLAG)=0
FOR
SET QAN=$ORDER(^QA(742.4,QANIEN,1,QAN))
if QAN'>0
QUIT
DO DESCR
if QANFIN["^"
QUIT
+15 IF QANBLNK
WRITE !!?5,"INCIDENT DESCRIPTION: ",!!
+16 SET QANFLAG=0
if QANFIN["^"
QUIT
+17 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !!!?5,"SIGNATURE AND TITLE OF REPORTER: _________________________",!
+18 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE ?5,"DATE: __________",!
+19 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !?5,"PHYSICIAN'S EXAMINATION FINDINGS/ACTIONS:",!!!!!
+20 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !?10,"SEVERITY LEVEL: 0 1 2 3"
+21 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !!?10,"EXAMINING PHYSICIAN'S SIGNATURE: _________________________",!?10,"DATE: __________",!
+22 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !?5,"SERVICE LEVEL FINDINGS/ACTIONS:",!!!
+23 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !?10,"SIGNATURE: _________________________",!?10,"DATE: __________",!!
+24 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE $GET(QANEQ),!
+25 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !?5,"CHIEF OF STAFF REVIEW:",!!?5,"INCIDENT TYPE: ",$GET(QANINCD)
+26 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
+27 IF 'QANBLNK
IF ($DATA(^QA(742,QANDFN,1,0)))
WRITE !?5,"RESPONSIBLE SERVICE: "
SET (QAN,QANFLAG)=0
FOR
SET QAN=$ORDER(^QA(742,QANDFN,1,QAN))
if QAN'>0
QUIT
DO RSERV
if QANFIN["^"
QUIT
+28 IF QANBLNK
WRITE !?5,"RESPONSIBLE SERVICE: "
+29 SET QANFLAG=0
if QANFIN["^"
QUIT
+30 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !!?5,"COMMENTS: ",!!!
+31 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !?5,"RECOMMENDATIONS FOR FURTHER FOLLOW-UP: ",!?10,"NO",!?10,"YES",!
+32 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !?10,"SPECIFY:",!!!
+33 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !?10,"COS SIGNATURE: _________________________",!?10,"DATE: __________"
+34 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !!,$GET(QANEQ),!!?5,"DIRECTOR'S REVIEW:",!!
+35 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !?5,"ACTION TAKEN BY MEDICAL CENTER:",?45,"NEED FOR FURTHER REVIEW:"
+36 IF 'QANBLNK
IF ($DATA(^QA(742.4,QANIEN,2,0)))
SET (QAN,QAN(0),QANFLAG)=0
FOR
SET QAN=$ORDER(^QA(742.4,QANIEN,2,QAN))
if QAN'>0
QUIT
DO MEDC
if QANFIN["^"
QUIT
+37 SET QANFLAG=0
if QANFIN["^"
QUIT
+38 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
+39 IF 'QANBLNK
IF ('$DATA(^QA(742.4,QANIEN,2,0)))
WRITE !?45,$GET(QANLREV)
+40 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !!!?5,"DIRECTOR'S SIGNATURE: _________________________",!
+41 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE ?5,"DATE: __________",!
+42 QUIT
DESCR ;Incident Description word processing
+1 SET X=$GET(^QA(742.4,QANIEN,1,QAN,0))
SET DIWF=""
SET DIWR=50
SET DIWL=10
SET QANFLAG=1
+2 KILL ^UTILITY($JOB,"W")
DO ^DIWP
+3 SET QANMN=0
SET QANLBL="INCIDENT DESCRIPTION: "
+4 FOR
SET QANMN=+$ORDER(^UTILITY($JOB,"W",DIWL,QANMN))
if QANMN'>0
QUIT
if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !?15,^(QANMN,0)
+5 QUIT
RSERV ;Responsible Service multiple
+1 SET QANLBL="RESPONSIBLE SERVICE: "
SET QANFLAG=1
+2 SET Y=$PIECE(^QA(742,QANDFN,1,QAN,0),U)
SET C=$PIECE(^DD(742.01,.01,0),U,2)
if Y]""
DO Y^DIQ
+3 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !?15,Y
+4 QUIT
DIAG ;Patient Diagnosis multiple
+1 SET QANLBL="CLINICAL DIAGNOSIS: "
SET QANFLAG=1
+2 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !?15,$PIECE(^QA(742,QANDFN,2,QAN,0),U)
+3 QUIT
MEDC ;Medical Center Action multiple
+1 SET QAN(0)=QAN(0)+1
SET QANLBL="ACTION TAKEN BY MEDICAL CENTER: "
SET QANFLAG=1
+2 SET Y=$PIECE(^QA(742.4,QANIEN,2,QAN,0),U)
SET C=$PIECE(^DD(742.42,.01,0),U,2)
if Y]""
DO Y^DIQ
+3 if $Y>(IOSL-8)
DO HDH^QANPSDO
if QANFIN["^"
QUIT
WRITE !?10,Y
if QAN(0)=1
WRITE ?45,$GET(QANLREV)
+4 QUIT
