QANUTL1 ;HISC/GJC-UTILITIES FOR INCIDENT REPORTING (PATIENT DATA) ; 5/23/12 12:46pm
;;2.0;Incident Reporting;**20,27,32,33**;08/07/1992;Build 12
;
DICW ;Sets up output for patient lookup.
S QANY=$P(^QA(742,+Y,0),U),QANYY=+$P(^QA(742,+Y,0),U,3)
S QANSSN=$S($P(^DPT(QANY,0),U,9)]"":$P(^DPT(QANY,0),U,9),1:"")
N Y S Y=$P(^QA(742.4,QANYY,0),U,3) X ^DD("DD")
W " "_QANSSN_" "_Y_" "
Q:'$P(^QA(742.4,QANYY,0),U,2) ;;check for null incident
W $P(^QA(742.1,$P(^QA(742.4,QANYY,0),U,2),0),U)
K QANY,QANYY
Q
HDH ;
S QANPAGE=QANPAGE+1 W @IOF,!?62,"Date: ",QANDT,!,?62,"Page: ",QANPAGE,!,?(IOM-$L(QANHEAD)\2),QANHEAD
W:QANHEAD(0)]"" !,?(IOM-$L(QANHEAD(0))\2),QANHEAD(0)
W:QANLINE]"" !,QANLINE,!
Q
HDH1 ;
K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 QANEOP="^"
Q:QANEOP["^" D HDH
Q
PAT0 ;displays the patient(s) on IR, if any.
S QANEE=0 N QANPTFLG
K QANPTS
F S QANEE=$O(^QA(742,"BCS",QANIEN,QANEE)) Q:QANEE'>0 D
. S QANPTFLG=1
. S QANPTS(QANEE)=$P(^QA(742,QANEE,0),U)
Q:'$G(QANPTFLG)
W !!,"Patient(s) on this Incident Report."
S QANCC=0
F S QANCC=$O(QANPTS(QANCC)) Q:QANCC'>0 D
. W !?5,$P(^DPT(QANPTS(QANCC),0),U)
PAT ;Choose your patient.
K DIC S DIC="^QA(742,",DIC(0)="QEAMZ",DIC("A")="Select Patient: "
S DIC("S1")="I ""13""[+$P(^QA(742.4,+$P(^QA(742,+Y,0),U,3),0),U,8)"
S DIC("S2")="&($D(^QA(742,""BPRS"",1,+Y)))"
S DIC("S3")="I $P(^QA(742,+Y,0),U,3)=QANIEN"
S DIC("S")=$S(QANTYPE=3:DIC("S1")_DIC("S2"),1:DIC("S3")_DIC("S2"))
PAT1 ;entry point from EDIT1^QANDCNT
S DIC("W")="D DICW^QANUTL1",D="B^BS5" D MIX^DIC1
I $G(X)']"" W !!,$C(7),"You must enter patient's name to continue editing." G PAT1
K DIC
I +Y=-1 S QANXIT=1 W !!,$C(7),"Patient not selected, exiting!!" Q
S QANDFN=+Y,QANIEN=$P(Y(0),U,3),QAHOLD=$P(Y(0),U),QAHDNM=Y(0,0)
S QAHDSSN=$P(^DPT(+QAHOLD,0),U,9)
D EDTNME Q:QANXIT
S QANAME=$P(^DPT(QANPAT,0),U),QANDOB=$P(^DPT(QANPAT,0),U,3),QAN(0)=0 F QAN=0:0 S QAN=$O(^QA(742,"B",QANPAT,QAN)) Q:QAN'>0!(QAN(0)'<2) S:$D(^QA(742,"B",QANPAT,QAN)) QAN(0)=QAN(0)+1
I QANDOB]"" S X=DT,X1=X,X2=QANDOB,X="" D:X2 ^%DTC S X=X\365.25,QANAGE=X
I QAN(0)'<2 D RPT0
Q
RPT0 W $C(7) F W !!,"Patient has additional incidents on file.",!,"Do you wish to look at these incidents" S %=2 D YN^DICN Q:"-112"[% W !,$C(7),"Enter (Y)es, or (N)o, or ""^"" to quit."
S:%=-1 QANXIT=1
I %=-1!(%=2) Q
S QANPT(0)=$S($D(^DPT(QANPAT,0))#2:^(0),1:""),QANDT=DT,QANPAGE=0,Y=QANDT X ^DD("DD") S QANDT=Y,QANHEAD="Patient's Incident History.",QANHEAD(0)="",$P(QANLINE,"~",81)="",QANEOP="" D HDH
F QAN=0:0 S QAN=$O(^QA(742,"B",QANPAT,QAN)) Q:QAN'>0 D:$Y>(IOSL-4) HDH1 Q:QANEOP["^" W ! S QANPT0(0)=$S($D(^QA(742,QAN,0))#2:^(0),1:"") I QANPT0(0)]"" D RPT1
F W !!,"Do you wish to continue with the edit portion" S %=1 D YN^DICN Q:"-112"[% W !,"Enter ""Y"" for yes, ""N"" for no."
I %<0!(%=2) S QANXIT=1
Q
RPT1 S QANCS=$P(QANPT0(0),U,3),QANCS(0)=$S($D(^QA(742.4,QANCS,0))#2:^(0),1:"") Q:QANCS(0)']""
S QANIC=$P(QANCS(0),U,2),QANSTAT=+$P(QANCS(0),U,8)
D:$Y>(IOSL-4) HDH1 Q:QANEOP["^" W !,"Patient: ",$P(QANPT(0),U),?45,"Patient ID: ",$P(QANPT0(0),U,2)
D:$Y>(IOSL-4) HDH1 Q:QANEOP["^" W !,"Case Number: ",$P(QANCS(0),U),?45,"Incident: ",$S(QANIC]"":$P(^QA(742.1,QANIC,0),U),1:"<NONE>")
D:$Y>(IOSL-4) HDH1 Q:QANEOP["^" W !,"Date of the Incident: " S Y=$P(QANCS(0),U,3) X ^DD("DD") W Y,?45,"Incident Status: ",$S(QANSTAT=0:"Closed",QANSTAT=1:"Open",QANSTAT=3:"Open",1:"Deleted")
D:$Y>(IOSL-4) HDH1 Q:QANEOP["^" W !,"Incident Location: " W:$P(QANCS(0),U,4)]"" $P(^QA(742.5,$P(QANCS(0),U,4),0),U)
D:$Y>(IOSL-4) HDH1 Q:QANEOP["^" W !,"Severity Level: " S Y=$P(QANPT0(0),U,10),C=$P(^DD(742,.1,0),U,2) I Y]"" D Y^DIQ W Y
Q
ADMDT ;Grab the patient's admission date.
S QANWARD="" ;SETTING THE DEFAULT TO 'NULL'
S DFN=QANPIEN D INP^VADPT S QANADMDT=$S(VAIN(7)]"":+VAIN(7),1:"")
S QANTRSP=$S(VAIN(3)]"":+VAIN(3),1:"")
S QANINPAT=$S($D(^DPT(QANPIEN,.1)):1,1:0)
D:QANINPAT WARD
K DFN,VAIN
Q
EDTNME ;Edit the patients name.
K DIE,DR
S DIE="^QA(742,",DA=+Y,DR=".01 Patient" D ^DIE
S:$D(Y) QANXIT=1
S (QANPAT,QANPIEN)=+X
Q:QANXIT!(+X=QAHOLD) ;Exit on abnormal exit OR same patient
S QA2=$G(^DPT(+X,0)),QANSSN=$P(QA2,U,9),QA1=$P(QA2,U),QANDOB=$P(QA2,U,3)
S QANPID=$$QANPID^QANCDNT(QA1)
D ADMDT ;Grab ward, t spec, admit date, and patient type for new patient
S QANADMDT=$S(QANADMDT]"":QANADMDT,1:"@"),QANTRSP=$S(QANTRSP]"":QANTRSP,1:"@"),QANINPAT=$S(QANINPAT]"":QANINPAT,1:"@"),QANWARD=$S(QANWARD]"":QANWARD,1:"@"),QANPID=$S(QANPID]"":QANPID,1:"")
S DIE="^QA(742,",DA=QANDFN
F DR=".02///"_QANPID,".04///"_QANADMDT,".05///"_QANINPAT,".06///"_QANWARD,".07///"_QANTRSP D ^DIE
K QAUDIT S QAUDIT("FILE")="742^50",QAUDIT("DA")=QANDFN,QAUDIT("ACTION")="e",QAUDIT("COMMENT")="Editing a patient name for an incident record." D ^QAQAUDIT
I +$P(^QA(742.4,QANIEN,0),U,18) D ^QANPEDT ;Update patient name on NQADB
K QAUDIT,QA1,QANSSN,QANADMDT,QANPID,QANINPAT,QANWARD,QANTRSP,QA2,QAHOLD
K QAHDNM,QAHDSSN
Q
WARD ;
S QANWARD=$S(VAIN(4)]"":+VAIN(4),1:"") Q:QANWARD=""
I '$D(^DIC(42,QANWARD,0)) S QANWARD="" Q
S QANWARD=$S($D(^DIC(42,QANWARD,44)):+$P(^(44),U),1:"") Q:QANWARD=""
I '$D(^SC(QANWARD,0)) S QANWARD=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANUTL1 5222 printed Dec 13, 2024@02:00:11 Page 2
QANUTL1 ;HISC/GJC-UTILITIES FOR INCIDENT REPORTING (PATIENT DATA) ; 5/23/12 12:46pm
+1 ;;2.0;Incident Reporting;**20,27,32,33**;08/07/1992;Build 12
+2 ;
DICW ;Sets up output for patient lookup.
+1 SET QANY=$PIECE(^QA(742,+Y,0),U)
SET QANYY=+$PIECE(^QA(742,+Y,0),U,3)
+2 SET QANSSN=$SELECT($PIECE(^DPT(QANY,0),U,9)]"":$PIECE(^DPT(QANY,0),U,9),1:"")
+3 NEW Y
SET Y=$PIECE(^QA(742.4,QANYY,0),U,3)
XECUTE ^DD("DD")
+4 WRITE " "_QANSSN_" "_Y_" "
+5 ;;check for null incident
if '$PIECE(^QA(742.4,QANYY,0),U,2)
QUIT
+6 WRITE $PIECE(^QA(742.1,$PIECE(^QA(742.4,QANYY,0),U,2),0),U)
+7 KILL QANY,QANYY
+8 QUIT
HDH ;
+1 SET QANPAGE=QANPAGE+1
WRITE @IOF,!?62,"Date: ",QANDT,!,?62,"Page: ",QANPAGE,!,?(IOM-$LENGTH(QANHEAD)\2),QANHEAD
+2 if QANHEAD(0)]""
WRITE !,?(IOM-$LENGTH(QANHEAD(0))\2),QANHEAD(0)
+3 if QANLINE]""
WRITE !,QANLINE,!
+4 QUIT
HDH1 ;
+1 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
if +Y=0
SET QANEOP="^"
+2 if QANEOP["^"
QUIT
DO HDH
+3 QUIT
PAT0 ;displays the patient(s) on IR, if any.
+1 SET QANEE=0
NEW QANPTFLG
+2 KILL QANPTS
+3 FOR
SET QANEE=$ORDER(^QA(742,"BCS",QANIEN,QANEE))
if QANEE'>0
QUIT
Begin DoDot:1
+4 SET QANPTFLG=1
+5 SET QANPTS(QANEE)=$PIECE(^QA(742,QANEE,0),U)
End DoDot:1
+6 if '$GET(QANPTFLG)
QUIT
+7 WRITE !!,"Patient(s) on this Incident Report."
+8 SET QANCC=0
+9 FOR
SET QANCC=$ORDER(QANPTS(QANCC))
if QANCC'>0
QUIT
Begin DoDot:1
+10 WRITE !?5,$PIECE(^DPT(QANPTS(QANCC),0),U)
End DoDot:1
PAT ;Choose your patient.
+1 KILL DIC
SET DIC="^QA(742,"
SET DIC(0)="QEAMZ"
SET DIC("A")="Select Patient: "
+2 SET DIC("S1")="I ""13""[+$P(^QA(742.4,+$P(^QA(742,+Y,0),U,3),0),U,8)"
+3 SET DIC("S2")="&($D(^QA(742,""BPRS"",1,+Y)))"
+4 SET DIC("S3")="I $P(^QA(742,+Y,0),U,3)=QANIEN"
+5 SET DIC("S")=$SELECT(QANTYPE=3:DIC("S1")_DIC("S2"),1:DIC("S3")_DIC("S2"))
PAT1 ;entry point from EDIT1^QANDCNT
+1 SET DIC("W")="D DICW^QANUTL1"
SET D="B^BS5"
DO MIX^DIC1
+2 IF $GET(X)']""
WRITE !!,$CHAR(7),"You must enter patient's name to continue editing."
GOTO PAT1
+3 KILL DIC
+4 IF +Y=-1
SET QANXIT=1
WRITE !!,$CHAR(7),"Patient not selected, exiting!!"
QUIT
+5 SET QANDFN=+Y
SET QANIEN=$PIECE(Y(0),U,3)
SET QAHOLD=$PIECE(Y(0),U)
SET QAHDNM=Y(0,0)
+6 SET QAHDSSN=$PIECE(^DPT(+QAHOLD,0),U,9)
+7 DO EDTNME
if QANXIT
QUIT
+8 SET QANAME=$PIECE(^DPT(QANPAT,0),U)
SET QANDOB=$PIECE(^DPT(QANPAT,0),U,3)
SET QAN(0)=0
FOR QAN=0:0
SET QAN=$ORDER(^QA(742,"B",QANPAT,QAN))
if QAN'>0!(QAN(0)'<2)
QUIT
if $DATA(^QA(742,"B",QANPAT,QAN))
SET QAN(0)=QAN(0)+1
+9 IF QANDOB]""
SET X=DT
SET X1=X
SET X2=QANDOB
SET X=""
if X2
DO ^%DTC
SET X=X\365.25
SET QANAGE=X
+10 IF QAN(0)'<2
DO RPT0
+11 QUIT
RPT0 WRITE $CHAR(7)
FOR
WRITE !!,"Patient has additional incidents on file.",!,"Do you wish to look at these incidents"
SET %=2
DO YN^DICN
if "-112"[%
QUIT
WRITE !,$CHAR(7),"Enter (Y)es, or (N)o, or ""^"" to quit."
+1 if %=-1
SET QANXIT=1
+2 IF %=-1!(%=2)
QUIT
+3 SET QANPT(0)=$SELECT($DATA(^DPT(QANPAT,0))#2:^(0),1:"")
SET QANDT=DT
SET QANPAGE=0
SET Y=QANDT
XECUTE ^DD("DD")
SET QANDT=Y
SET QANHEAD="Patient's Incident History."
SET QANHEAD(0)=""
SET $PIECE(QANLINE,"~",81)=""
SET QANEOP=""
DO HDH
+4 FOR QAN=0:0
SET QAN=$ORDER(^QA(742,"B",QANPAT,QAN))
if QAN'>0
QUIT
if $Y>(IOSL-4)
DO HDH1
if QANEOP["^"
QUIT
WRITE !
SET QANPT0(0)=$SELECT($DATA(^QA(742,QAN,0))#2:^(0),1:"")
IF QANPT0(0)]""
DO RPT1
+5 FOR
WRITE !!,"Do you wish to continue with the edit portion"
SET %=1
DO YN^DICN
if "-112"[%
QUIT
WRITE !,"Enter ""Y"" for yes, ""N"" for no."
+6 IF %<0!(%=2)
SET QANXIT=1
+7 QUIT
RPT1 SET QANCS=$PIECE(QANPT0(0),U,3)
SET QANCS(0)=$SELECT($DATA(^QA(742.4,QANCS,0))#2:^(0),1:"")
if QANCS(0)']""
QUIT
+1 SET QANIC=$PIECE(QANCS(0),U,2)
SET QANSTAT=+$PIECE(QANCS(0),U,8)
+2 if $Y>(IOSL-4)
DO HDH1
if QANEOP["^"
QUIT
WRITE !,"Patient: ",$PIECE(QANPT(0),U),?45,"Patient ID: ",$PIECE(QANPT0(0),U,2)
+3 if $Y>(IOSL-4)
DO HDH1
if QANEOP["^"
QUIT
WRITE !,"Case Number: ",$PIECE(QANCS(0),U),?45,"Incident: ",$SELECT(QANIC]"":$PIECE(^QA(742.1,QANIC,0),U),1:"<NONE>")
+4 if $Y>(IOSL-4)
DO HDH1
if QANEOP["^"
QUIT
WRITE !,"Date of the Incident: "
SET Y=$PIECE(QANCS(0),U,3)
XECUTE ^DD("DD")
WRITE Y,?45,"Incident Status: ",$SELECT(QANSTAT=0:"Closed",QANSTAT=1:"Open",QANSTAT=3:"Open",1:"Deleted")
+5 if $Y>(IOSL-4)
DO HDH1
if QANEOP["^"
QUIT
WRITE !,"Incident Location: "
if $PIECE(QANCS(0),U,4)]""
WRITE $PIECE(^QA(742.5,$PIECE(QANCS(0),U,4),0),U)
+6 if $Y>(IOSL-4)
DO HDH1
if QANEOP["^"
QUIT
WRITE !,"Severity Level: "
SET Y=$PIECE(QANPT0(0),U,10)
SET C=$PIECE(^DD(742,.1,0),U,2)
IF Y]""
DO Y^DIQ
WRITE Y
+7 QUIT
ADMDT ;Grab the patient's admission date.
+1 ;SETTING THE DEFAULT TO 'NULL'
SET QANWARD=""
+2 SET DFN=QANPIEN
DO INP^VADPT
SET QANADMDT=$SELECT(VAIN(7)]"":+VAIN(7),1:"")
+3 SET QANTRSP=$SELECT(VAIN(3)]"":+VAIN(3),1:"")
+4 SET QANINPAT=$SELECT($DATA(^DPT(QANPIEN,.1)):1,1:0)
+5 if QANINPAT
DO WARD
+6 KILL DFN,VAIN
+7 QUIT
EDTNME ;Edit the patients name.
+1 KILL DIE,DR
+2 SET DIE="^QA(742,"
SET DA=+Y
SET DR=".01 Patient"
DO ^DIE
+3 if $DATA(Y)
SET QANXIT=1
+4 SET (QANPAT,QANPIEN)=+X
+5 ;Exit on abnormal exit OR same patient
if QANXIT!(+X=QAHOLD)
QUIT
+6 SET QA2=$GET(^DPT(+X,0))
SET QANSSN=$PIECE(QA2,U,9)
SET QA1=$PIECE(QA2,U)
SET QANDOB=$PIECE(QA2,U,3)
+7 SET QANPID=$$QANPID^QANCDNT(QA1)
+8 ;Grab ward, t spec, admit date, and patient type for new patient
DO ADMDT
+9 SET QANADMDT=$SELECT(QANADMDT]"":QANADMDT,1:"@")
SET QANTRSP=$SELECT(QANTRSP]"":QANTRSP,1:"@")
SET QANINPAT=$SELECT(QANINPAT]"":QANINPAT,1:"@")
SET QANWARD=$SELECT(QANWARD]"":QANWARD,1:"@")
SET QANPID=$SELECT(QANPID]"":QANPID,1:"")
+10 SET DIE="^QA(742,"
SET DA=QANDFN
+11 FOR DR=".02///"_QANPID,".04///"_QANADMDT,".05///"_QANINPAT,".06///"_QANWARD,".07///"_QANTRSP
DO ^DIE
+12 KILL QAUDIT
SET QAUDIT("FILE")="742^50"
SET QAUDIT("DA")=QANDFN
SET QAUDIT("ACTION")="e"
SET QAUDIT("COMMENT")="Editing a patient name for an incident record."
DO ^QAQAUDIT
+13 ;Update patient name on NQADB
IF +$PIECE(^QA(742.4,QANIEN,0),U,18)
DO ^QANPEDT
+14 KILL QAUDIT,QA1,QANSSN,QANADMDT,QANPID,QANINPAT,QANWARD,QANTRSP,QA2,QAHOLD
+15 KILL QAHDNM,QAHDSSN
+16 QUIT
WARD ;
+1 SET QANWARD=$SELECT(VAIN(4)]"":+VAIN(4),1:"")
if QANWARD=""
QUIT
+2 IF '$DATA(^DIC(42,QANWARD,0))
SET QANWARD=""
QUIT
+3 SET QANWARD=$SELECT($DATA(^DIC(42,QANWARD,44)):+$PIECE(^(44),U),1:"")
if QANWARD=""
QUIT
+4 IF '$DATA(^SC(QANWARD,0))
SET QANWARD=""
+5 QUIT
