source: WorldVistAEHR/trunk/r/INCIDENT_REPORTING-QAN/QANCNVT.m@ 1593

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

initial load of WorldVistAEHR
File size: 3.3 KB
RevLine 
[613]1QANCNVT ;HISC/GJC,DAD-Conversion of incident type from V1.01 TO V2.0 ;10/9/92
2 ;;2.0;Incident Reporting;**1,2,4,5,18**;08/07/1992
3EN1 ; Passed in variable 'PRMQINC' *** old incident code (.01 of 513.941)
4 D KILL K QANINCD S QANFLG=0
5 F QAN=1:1 S QA("NEW NAME")=$P($T(TYPTXT+QAN),";;",2),QA("OLD CODES")=$P($T(TYPTXT+QAN),";;",3) Q:QA("NEW NAME")']"" D CHKNME Q:QANFLG
6 D:'QANFLG CONVERT
7 I QANXIT W !!,*7,"Error in converting incident types for file 742.1.",!,"Contact your site manager.",*7 S $P(^PRMQ(513.72,PRMQIEN,0),U,3)=1
8KILL ;
9 K QANCT,QANCNT,QANVV,QANXX,QANZZ
10 Q
11CHKNME ;Piece off 'old' incident codes.
12 F QANCNT=1:1:$L(QA("OLD CODES"),U) S QA("OLD CODE")=$P(QA("OLD CODES"),U,QANCNT) I QA("OLD CODE")=PRMQINC D
13 . I $D(^QA(742.1,"BUPPER",QA("NEW NAME"))) S QANINCD=$O(^QA(742.1,"BUPPER",QA("NEW NAME"),0))
14 S:+$G(QANINCD) QANFLG=1
15 Q
16CONVERT ;Convert 'old' incident into a 'new' one.
17 I $D(^PRMQ(513.941,"B",PRMQINC)) S PRMQINC(0)=$O(^PRMQ(513.941,"B",PRMQINC,0))
18 I +$G(PRMQINC(0)) S PRMQINC(1)=$P($G(^PRMQ(513.941,PRMQINC(0),0)),U,2) D:PRMQINC(1)]""
19 . I $D(^QA(742.1,"B",PRMQINC(1))) S QANINCD=$O(^QA(742.1,"B",PRMQINC(1),0)) Q ;Exists, quit
20 . F QAN=199.99:0 S QAN=$O(^QA(742.1,QAN)) Q:QAN'>0 S QAN("LAST")=QAN
21 . K DA,DD,DIC,DINUM,DLAYGO,DO
22 . S DINUM=$S('$D(QAN("LAST")):200,1:(QAN("LAST")+.01)) S:DINUM>999.99 QANXIT=1 Q:QANXIT
23 . S DIC="^QA(742.1,",DIC(0)="LZ",X=PRMQINC(1),QANINCD=DINUM D FILE^DICN
24 . I +Y'>0 S QANXIT=1 Q
25 . S $P(^QA(742.1,+Y,0),U,6)="1"
26 . K DA,DD,DIC,DINUM,DLAYGO,DO,X
27 E S QANXIT=1
28 Q
29PAT ;Creating an entry in file 742.
30 S VAINDT=QANDATE,DFN=QANPAT D INP^VADPT S QANADMDT=$P(VAIN(7),U)
31 K DA,DD,DIC,DINUM,DLAYGO,DO
32 S DIC="^QA(742,",DIC(0)="LZ",X=QANPAT D FILE^DICN
33 K DD,DIC,DINUM,DLAYGO,DO
34 I +Y'>0 W !!,*7,"Error in data conversion, contact your site manager.",*7 S $P(^PRMQ(513.72,PRMQIEN,0),U,3)=1 Q
35 S QANIEN(742)=+Y,QANNODE(742)=$G(^QA(742,QANIEN(742),0))
36 Q:QANNODE(742)']""
37 S $P(QANNODE(742),U,2,7)=$G(QANPID)_U_QANIEN(7424)_U_QANADMDT_U_QANPTY_U_QANWARD_U_QANTREAT
38 S $P(QANNODE(742),U,10)=$S(PRMQINC="111E":3,1:$G(QANSLEV))
39 S $P(QANNODE(742),U,12)=$S(PRMQDISP]""!($G(QANLVL(0))="CA"):0,1:1)
40 S ^QA(742,QANIEN(742),0)=QANNODE(742) D SVLEV
41 K DA,DIK S DA=QANIEN(742),DIK="^QA(742," D IX^DIK K DA,DIK ;Reindex file 742
42 Q
43SVLEV ;Setting the responsible service multiple
44 Q:'$D(^TMP($J,"QAN RESPONSIBLE SERVICE"))
45 S:'$D(^QA(742,QANIEN(742),1,0))#2 ^QA(742,QANIEN(742),1,0)="^742.01P^^"
46 F QAN=0:0 S QAN=$O(^TMP($J,"QAN RESPONSIBLE SERVICE",QAN)) Q:QAN'>0 D
47 . K DA,DD,DIC,DINUM,DLAYGO,DO
48 . S DA(1)=QANIEN(742),DIC="^QA(742,"_QANIEN(742)_",1,",DIC(0)="LZ"
49 . S X=QAN D FILE^DICN
50 . K DA,DD,DIC,DINUM,DLAYGO,DO
51 . Q
52 Q
53TYPTXT ; TEXT OF FILE 742.1 EQUIVALENT
54 ;;ADVERSE REACTION TO DRUG/ANESTHETIC;;109C^111E
55 ;;ASSAULT-PATIENT TO PATIENT;;113
56 ;;ASSAULT-PATIENT/STAFF;;114
57 ;;DEATH;;110^110A^111^111A^111B^111C^111D^111F^115G
58 ;;DIAGNOSTIC ERROR;;115E
59 ;;FALL;;106^106A
60 ;;FIRE-PATIENT INVOLVED IN;;112
61 ;;HOMICIDE;;104B^113B^114B^115H
62 ;;INACCURATE COUNTS IN SURGERY;;115C
63 ;;INFORMED CONSENT-FAIL. TO OBTAIN;;115B
64 ;;MEDICATION ERROR;;108^108A
65 ;;PATIENT ABUSE;;104^105
66 ;;INJURY NOT OTHERWISE LISTED;;109A^109B^109D
67 ;;SEXUAL ASSAULT;;104A^113A^114A
68 ;;REACT. TO BLOOD/BLOOD PRODUCTS;;115D
69 ;;MISSING PATIENT;;115A
70 ;;SUICIDE;;103
71 ;;SUICIDE ATTEMPT;;102
72 ;;TRANSFUSION ERROR;;107
73 Q
Note: See TracBrowser for help on using the repository browser.