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