QANQTTL ;GJC/HISC-QUARTERLY REPORT OF INVESTIGATIONS (REGIONAL) ;2/27/92
;;2.0;Incident Reporting;;08/07/1992
N QANXIT S QANXIT=0 ;Set flag for abnormal exit
F WW=0:0 S WW=$O(QANARRY(WW)) Q:WW'>0!(QANXIT) S XX="" F YY=0:0 S XX=$O(QANARRY(WW,XX)) Q:XX=""!(QANXIT) S ZZ="" F AA=0:0 S ZZ=$O(QANARRY(WW,XX,ZZ)) Q:ZZ=""!(QANXIT) D LOOP
Q
DELETE ;Delete a non-lockable entry.
L -^QA(742.6,QANIEN) S QANXIT=1
K DA,DIK
S DA=QANIEN,DIK="^QA(742.6," D ^DIK
K DA,DIK
Q
LOOP ;Check the results of the array.
S QANINCD=WW,QANALPV=XX,QANPTTY=ZZ
S QANFLD=".01^.02^.03^.04^.05^.06^.07^.08^.09^.1^.11^.12^.13^.14^.15^.16"
S QANX(1)=QANMED,QANX(2)=QANDATE,QANX(3)=QANPTTY,QANX(4)=QANINCD
S QANX(5)=+$G(QANARRY(QANINCD,QANALPV,QANPTTY,0))
S QANX(6)=+$G(QANARRY(QANINCD,QANALPV,QANPTTY,1))
S QANX(7)=+$G(QANARRY(QANINCD,QANALPV,QANPTTY,0,0))
S QANX(8)=+$G(QANARRY(QANINCD,QANALPV,QANPTTY,0,1))
S QANX(9)=+$G(QANARRY(QANINCD,QANALPV,QANPTTY,0,2))
S QANX(10)=+$G(QANARRY(QANINCD,QANALPV,QANPTTY,0,3))
S QANX(11)=+$G(QANARRY(QANINCD,QANALPV,QANPTTY,1,0))
S QANX(12)=+$G(QANARRY(QANINCD,QANALPV,QANPTTY,1,1))
S QANX(13)=+$G(QANARRY(QANINCD,QANALPV,QANPTTY,1,2))
S QANX(14)=+$G(QANARRY(QANINCD,QANALPV,QANPTTY,1,3)),QANX(15)=QANTODAY,QANX(16)=$S($D(^QA(742.1,"BUPPER","PATIENT ABUSE",QANINCD)):QANALPV,1:"")
K DD,DIC,DINUM,DLAYGO,DO
S DIC="^QA(742.6,",DIC(0)="L",DLAYGO=742.6,X=QANX(1)
D FILE^DICN K DD,DIC,DINUM,DLAYGO,DO
Q:+Y=-1 ;Bad entry
S QANIEN=+Y ;First Level, DA(1) - D0.
L +^QA(742.6,QANIEN):0
I '$T W !,*7,"File entry is locked, exiting." D DELETE Q:QANXIT
K DA,DIE,DR S DIE="^QA(742.6,",DA=QANIEN
F BB=2:1:$L(QANFLD,U) S DR=$P(QANFLD,U,BB)_"///"_QANX(BB) D ^DIE
K DA,DIE,DR
I $D(^QA(742.1,"BUPPER","DEATH",QANINCD)),$D(QANARRY("QAN D",QANINCD,QANPTTY)) D DTH0
L -^QA(742.6,QANIEN) ;Unlock previously locked global.
Q
DTH0 ;Creating and entry for death.
N QANFLD,QANX ;New previously used vars.
F CC=0:0 S CC=$O(^QA(742.14,CC)) Q:CC'>0 I '$D(QANARRY("QAN D",QANINCD,QANPTTY,CC)) S QANARRY("QAN D",QANINCD,QANPTTY,CC,0)="",QANARRY("QAN D",QANINCD,QANPTTY,CC,1)=""
F CC=0:0 S CC=$O(QANARRY("QAN D",QANINCD,QANPTTY,CC)) Q:CC'>0 D DTH1
Q
DTH1 ;Store deaths.
I '$D(^QA(742.6,QANIEN,1,0))#2 S ^QA(742.6,QANIEN,1,0)="^742.61PA^^"
S QANFLD=".01^.02^.03"
S QANX(1)=CC,QANX(2)=+$G(QANARRY("QAN D",QANINCD,QANPTTY,CC,0))
S QANX(3)=+$G(QANARRY("QAN D",QANINCD,QANPTTY,CC,1))
K DD,DIC,DINUM,DLAYGO,DO
S DIC="^QA(742.6,"_QANIEN_",1,",DIC(0)="L",DLAYGO=742.61,X=QANX(1)
S DA(1)=QANIEN D FILE^DICN K DD,DIC,DINUM,DLAYGO,DO
Q:+Y=-1 ;Bad entry
S QANDFN=+Y ;2nd level, DA - D1
K DA,DIE,DR S DIE="^QA(742.6,"_QANIEN_",1,",DA(1)=QANIEN,DA=QANDFN
F BB=2:1:$L(QANFLD,U) S DR=$P(QANFLD,U,BB)_"///"_QANX(BB) D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANQTTL 2792 printed Nov 22, 2024@17:10:12 Page 2
QANQTTL ;GJC/HISC-QUARTERLY REPORT OF INVESTIGATIONS (REGIONAL) ;2/27/92
+1 ;;2.0;Incident Reporting;;08/07/1992
+2 ;Set flag for abnormal exit
NEW QANXIT
SET QANXIT=0
+3 FOR WW=0:0
SET WW=$ORDER(QANARRY(WW))
if WW'>0!(QANXIT)
QUIT
SET XX=""
FOR YY=0:0
SET XX=$ORDER(QANARRY(WW,XX))
if XX=""!(QANXIT)
QUIT
SET ZZ=""
FOR AA=0:0
SET ZZ=$ORDER(QANARRY(WW,XX,ZZ))
if ZZ=""!(QANXIT)
QUIT
DO LOOP
+4 QUIT
DELETE ;Delete a non-lockable entry.
+1 LOCK -^QA(742.6,QANIEN)
SET QANXIT=1
+2 KILL DA,DIK
+3 SET DA=QANIEN
SET DIK="^QA(742.6,"
DO ^DIK
+4 KILL DA,DIK
+5 QUIT
LOOP ;Check the results of the array.
+1 SET QANINCD=WW
SET QANALPV=XX
SET QANPTTY=ZZ
+2 SET QANFLD=".01^.02^.03^.04^.05^.06^.07^.08^.09^.1^.11^.12^.13^.14^.15^.16"
+3 SET QANX(1)=QANMED
SET QANX(2)=QANDATE
SET QANX(3)=QANPTTY
SET QANX(4)=QANINCD
+4 SET QANX(5)=+$GET(QANARRY(QANINCD,QANALPV,QANPTTY,0))
+5 SET QANX(6)=+$GET(QANARRY(QANINCD,QANALPV,QANPTTY,1))
+6 SET QANX(7)=+$GET(QANARRY(QANINCD,QANALPV,QANPTTY,0,0))
+7 SET QANX(8)=+$GET(QANARRY(QANINCD,QANALPV,QANPTTY,0,1))
+8 SET QANX(9)=+$GET(QANARRY(QANINCD,QANALPV,QANPTTY,0,2))
+9 SET QANX(10)=+$GET(QANARRY(QANINCD,QANALPV,QANPTTY,0,3))
+10 SET QANX(11)=+$GET(QANARRY(QANINCD,QANALPV,QANPTTY,1,0))
+11 SET QANX(12)=+$GET(QANARRY(QANINCD,QANALPV,QANPTTY,1,1))
+12 SET QANX(13)=+$GET(QANARRY(QANINCD,QANALPV,QANPTTY,1,2))
+13 SET QANX(14)=+$GET(QANARRY(QANINCD,QANALPV,QANPTTY,1,3))
SET QANX(15)=QANTODAY
SET QANX(16)=$SELECT($DATA(^QA(742.1,"BUPPER","PATIENT ABUSE",QANINCD)):QANALPV,1:"")
+14 KILL DD,DIC,DINUM,DLAYGO,DO
+15 SET DIC="^QA(742.6,"
SET DIC(0)="L"
SET DLAYGO=742.6
SET X=QANX(1)
+16 DO FILE^DICN
KILL DD,DIC,DINUM,DLAYGO,DO
+17 ;Bad entry
if +Y=-1
QUIT
+18 ;First Level, DA(1) - D0.
SET QANIEN=+Y
+19 LOCK +^QA(742.6,QANIEN):0
+20 IF '$TEST
WRITE !,*7,"File entry is locked, exiting."
DO DELETE
if QANXIT
QUIT
+21 KILL DA,DIE,DR
SET DIE="^QA(742.6,"
SET DA=QANIEN
+22 FOR BB=2:1:$LENGTH(QANFLD,U)
SET DR=$PIECE(QANFLD,U,BB)_"///"_QANX(BB)
DO ^DIE
+23 KILL DA,DIE,DR
+24 IF $DATA(^QA(742.1,"BUPPER","DEATH",QANINCD))
IF $DATA(QANARRY("QAN D",QANINCD,QANPTTY))
DO DTH0
+25 ;Unlock previously locked global.
LOCK -^QA(742.6,QANIEN)
+26 QUIT
DTH0 ;Creating and entry for death.
+1 ;New previously used vars.
NEW QANFLD,QANX
+2 FOR CC=0:0
SET CC=$ORDER(^QA(742.14,CC))
if CC'>0
QUIT
IF '$DATA(QANARRY("QAN D",QANINCD,QANPTTY,CC))
SET QANARRY("QAN D",QANINCD,QANPTTY,CC,0)=""
SET QANARRY("QAN D",QANINCD,QANPTTY,CC,1)=""
+3 FOR CC=0:0
SET CC=$ORDER(QANARRY("QAN D",QANINCD,QANPTTY,CC))
if CC'>0
QUIT
DO DTH1
+4 QUIT
DTH1 ;Store deaths.
+1 IF '$DATA(^QA(742.6,QANIEN,1,0))#2
SET ^QA(742.6,QANIEN,1,0)="^742.61PA^^"
+2 SET QANFLD=".01^.02^.03"
+3 SET QANX(1)=CC
SET QANX(2)=+$GET(QANARRY("QAN D",QANINCD,QANPTTY,CC,0))
+4 SET QANX(3)=+$GET(QANARRY("QAN D",QANINCD,QANPTTY,CC,1))
+5 KILL DD,DIC,DINUM,DLAYGO,DO
+6 SET DIC="^QA(742.6,"_QANIEN_",1,"
SET DIC(0)="L"
SET DLAYGO=742.61
SET X=QANX(1)
+7 SET DA(1)=QANIEN
DO FILE^DICN
KILL DD,DIC,DINUM,DLAYGO,DO
+8 ;Bad entry
if +Y=-1
QUIT
+9 ;2nd level, DA - D1
SET QANDFN=+Y
+10 KILL DA,DIE,DR
SET DIE="^QA(742.6,"_QANIEN_",1,"
SET DA(1)=QANIEN
SET DA=QANDFN
+11 FOR BB=2:1:$LENGTH(QANFLD,U)
SET DR=$PIECE(QANFLD,U,BB)_"///"_QANX(BB)
DO ^DIE
+12 QUIT
