| 1 | QANQTTL ;GJC/HISC-QUARTERLY REPORT OF INVESTIGATIONS (REGIONAL) ;2/27/92
|
|---|
| 2 | ;;2.0;Incident Reporting;;08/07/1992
|
|---|
| 3 | N QANXIT S QANXIT=0 ;Set flag for abnormal exit
|
|---|
| 4 | 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
|
|---|
| 5 | Q
|
|---|
| 6 | DELETE ;Delete a non-lockable entry.
|
|---|
| 7 | L -^QA(742.6,QANIEN) S QANXIT=1
|
|---|
| 8 | K DA,DIK
|
|---|
| 9 | S DA=QANIEN,DIK="^QA(742.6," D ^DIK
|
|---|
| 10 | K DA,DIK
|
|---|
| 11 | Q
|
|---|
| 12 | LOOP ;Check the results of the array.
|
|---|
| 13 | S QANINCD=WW,QANALPV=XX,QANPTTY=ZZ
|
|---|
| 14 | S QANFLD=".01^.02^.03^.04^.05^.06^.07^.08^.09^.1^.11^.12^.13^.14^.15^.16"
|
|---|
| 15 | S QANX(1)=QANMED,QANX(2)=QANDATE,QANX(3)=QANPTTY,QANX(4)=QANINCD
|
|---|
| 16 | S QANX(5)=+$G(QANARRY(QANINCD,QANALPV,QANPTTY,0))
|
|---|
| 17 | S QANX(6)=+$G(QANARRY(QANINCD,QANALPV,QANPTTY,1))
|
|---|
| 18 | S QANX(7)=+$G(QANARRY(QANINCD,QANALPV,QANPTTY,0,0))
|
|---|
| 19 | S QANX(8)=+$G(QANARRY(QANINCD,QANALPV,QANPTTY,0,1))
|
|---|
| 20 | S QANX(9)=+$G(QANARRY(QANINCD,QANALPV,QANPTTY,0,2))
|
|---|
| 21 | S QANX(10)=+$G(QANARRY(QANINCD,QANALPV,QANPTTY,0,3))
|
|---|
| 22 | S QANX(11)=+$G(QANARRY(QANINCD,QANALPV,QANPTTY,1,0))
|
|---|
| 23 | S QANX(12)=+$G(QANARRY(QANINCD,QANALPV,QANPTTY,1,1))
|
|---|
| 24 | S QANX(13)=+$G(QANARRY(QANINCD,QANALPV,QANPTTY,1,2))
|
|---|
| 25 | 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:"")
|
|---|
| 26 | K DD,DIC,DINUM,DLAYGO,DO
|
|---|
| 27 | S DIC="^QA(742.6,",DIC(0)="L",DLAYGO=742.6,X=QANX(1)
|
|---|
| 28 | D FILE^DICN K DD,DIC,DINUM,DLAYGO,DO
|
|---|
| 29 | Q:+Y=-1 ;Bad entry
|
|---|
| 30 | S QANIEN=+Y ;First Level, DA(1) - D0.
|
|---|
| 31 | L +^QA(742.6,QANIEN):0
|
|---|
| 32 | I '$T W !,*7,"File entry is locked, exiting." D DELETE Q:QANXIT
|
|---|
| 33 | K DA,DIE,DR S DIE="^QA(742.6,",DA=QANIEN
|
|---|
| 34 | F BB=2:1:$L(QANFLD,U) S DR=$P(QANFLD,U,BB)_"///"_QANX(BB) D ^DIE
|
|---|
| 35 | K DA,DIE,DR
|
|---|
| 36 | I $D(^QA(742.1,"BUPPER","DEATH",QANINCD)),$D(QANARRY("QAN D",QANINCD,QANPTTY)) D DTH0
|
|---|
| 37 | L -^QA(742.6,QANIEN) ;Unlock previously locked global.
|
|---|
| 38 | Q
|
|---|
| 39 | DTH0 ;Creating and entry for death.
|
|---|
| 40 | N QANFLD,QANX ;New previously used vars.
|
|---|
| 41 | 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)=""
|
|---|
| 42 | F CC=0:0 S CC=$O(QANARRY("QAN D",QANINCD,QANPTTY,CC)) Q:CC'>0 D DTH1
|
|---|
| 43 | Q
|
|---|
| 44 | DTH1 ;Store deaths.
|
|---|
| 45 | I '$D(^QA(742.6,QANIEN,1,0))#2 S ^QA(742.6,QANIEN,1,0)="^742.61PA^^"
|
|---|
| 46 | S QANFLD=".01^.02^.03"
|
|---|
| 47 | S QANX(1)=CC,QANX(2)=+$G(QANARRY("QAN D",QANINCD,QANPTTY,CC,0))
|
|---|
| 48 | S QANX(3)=+$G(QANARRY("QAN D",QANINCD,QANPTTY,CC,1))
|
|---|
| 49 | K DD,DIC,DINUM,DLAYGO,DO
|
|---|
| 50 | S DIC="^QA(742.6,"_QANIEN_",1,",DIC(0)="L",DLAYGO=742.61,X=QANX(1)
|
|---|
| 51 | S DA(1)=QANIEN D FILE^DICN K DD,DIC,DINUM,DLAYGO,DO
|
|---|
| 52 | Q:+Y=-1 ;Bad entry
|
|---|
| 53 | S QANDFN=+Y ;2nd level, DA - D1
|
|---|
| 54 | K DA,DIE,DR S DIE="^QA(742.6,"_QANIEN_",1,",DA(1)=QANIEN,DA=QANDFN
|
|---|
| 55 | F BB=2:1:$L(QANFLD,U) S DR=$P(QANFLD,U,BB)_"///"_QANX(BB) D ^DIE
|
|---|
| 56 | Q
|
|---|
