source: FOIAVistA/trunk/r/INCIDENT_REPORTING-QAN/QANQTTL.m@ 1154

Last change on this file since 1154 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 2.7 KB
Line 
1QANQTTL ;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
6DELETE ;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
12LOOP ;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
39DTH0 ;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
44DTH1 ;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
Note: See TracBrowser for help on using the repository browser.