source: FOIAVistA/trunk/r/INCIDENT_REPORTING-QAN/QANCNVT.m@ 1250

QANCNVT ;HISC/GJC,DAD-Conversion of incident type from V1.01 TO V2.0 ;10/9/92
 ;;2.0;Incident Reporting;**1,2,4,5,18**;08/07/1992
EN1 ; Passed in variable 'PRMQINC' *** old incident code (.01 of 513.941)
 D KILL K QANINCD S QANFLG=0
 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
 D:'QANFLG CONVERT
 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
KILL ;
 K QANCT,QANCNT,QANVV,QANXX,QANZZ
 Q
CHKNME ;Piece off 'old' incident codes.
 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
 . I $D(^QA(742.1,"BUPPER",QA("NEW NAME"))) S QANINCD=$O(^QA(742.1,"BUPPER",QA("NEW NAME"),0))
 S:+$G(QANINCD) QANFLG=1
 Q
CONVERT ;Convert 'old' incident into a 'new' one.
 I $D(^PRMQ(513.941,"B",PRMQINC)) S PRMQINC(0)=$O(^PRMQ(513.941,"B",PRMQINC,0))
 I +$G(PRMQINC(0)) S PRMQINC(1)=$P($G(^PRMQ(513.941,PRMQINC(0),0)),U,2) D:PRMQINC(1)]""
 . I $D(^QA(742.1,"B",PRMQINC(1))) S QANINCD=$O(^QA(742.1,"B",PRMQINC(1),0)) Q  ;Exists, quit
 . F QAN=199.99:0 S QAN=$O(^QA(742.1,QAN)) Q:QAN'>0  S QAN("LAST")=QAN
 . K DA,DD,DIC,DINUM,DLAYGO,DO
 . S DINUM=$S('$D(QAN("LAST")):200,1:(QAN("LAST")+.01)) S:DINUM>999.99 QANXIT=1 Q:QANXIT
 . S DIC="^QA(742.1,",DIC(0)="LZ",X=PRMQINC(1),QANINCD=DINUM D FILE^DICN
 . I +Y'>0 S QANXIT=1 Q
 . S $P(^QA(742.1,+Y,0),U,6)="1"
 . K DA,DD,DIC,DINUM,DLAYGO,DO,X
 E  S QANXIT=1
 Q
PAT ;Creating an entry in file 742.
 S VAINDT=QANDATE,DFN=QANPAT D INP^VADPT S QANADMDT=$P(VAIN(7),U)
 K DA,DD,DIC,DINUM,DLAYGO,DO
 S DIC="^QA(742,",DIC(0)="LZ",X=QANPAT D FILE^DICN
 K DD,DIC,DINUM,DLAYGO,DO
 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
 S QANIEN(742)=+Y,QANNODE(742)=$G(^QA(742,QANIEN(742),0))
 Q:QANNODE(742)']""
 S $P(QANNODE(742),U,2,7)=$G(QANPID)_U_QANIEN(7424)_U_QANADMDT_U_QANPTY_U_QANWARD_U_QANTREAT
 S $P(QANNODE(742),U,10)=$S(PRMQINC="111E":3,1:$G(QANSLEV))
 S $P(QANNODE(742),U,12)=$S(PRMQDISP]""!($G(QANLVL(0))="CA"):0,1:1)
 S ^QA(742,QANIEN(742),0)=QANNODE(742) D SVLEV
 K DA,DIK S DA=QANIEN(742),DIK="^QA(742," D IX^DIK K DA,DIK ;Reindex file 742
 Q
SVLEV ;Setting the responsible service multiple
 Q:'$D(^TMP($J,"QAN RESPONSIBLE SERVICE"))
 S:'$D(^QA(742,QANIEN(742),1,0))#2 ^QA(742,QANIEN(742),1,0)="^742.01P^^"
 F QAN=0:0 S QAN=$O(^TMP($J,"QAN RESPONSIBLE SERVICE",QAN)) Q:QAN'>0  D
 . K DA,DD,DIC,DINUM,DLAYGO,DO
 . S DA(1)=QANIEN(742),DIC="^QA(742,"_QANIEN(742)_",1,",DIC(0)="LZ"
 . S X=QAN D FILE^DICN
 . K DA,DD,DIC,DINUM,DLAYGO,DO
 . Q
 Q
TYPTXT ; TEXT OF FILE 742.1 EQUIVALENT
 ;;ADVERSE REACTION TO DRUG/ANESTHETIC;;109C^111E
 ;;ASSAULT-PATIENT TO PATIENT;;113
 ;;ASSAULT-PATIENT/STAFF;;114
 ;;DEATH;;110^110A^111^111A^111B^111C^111D^111F^115G
 ;;DIAGNOSTIC ERROR;;115E
 ;;FALL;;106^106A
 ;;FIRE-PATIENT INVOLVED IN;;112
 ;;HOMICIDE;;104B^113B^114B^115H
 ;;INACCURATE COUNTS IN SURGERY;;115C
 ;;INFORMED CONSENT-FAIL. TO OBTAIN;;115B
 ;;MEDICATION ERROR;;108^108A
 ;;PATIENT ABUSE;;104^105
 ;;INJURY NOT OTHERWISE LISTED;;109A^109B^109D
 ;;SEXUAL ASSAULT;;104A^113A^114A
 ;;REACT. TO BLOOD/BLOOD PRODUCTS;;115D
 ;;MISSING PATIENT;;115A
 ;;SUICIDE;;103
 ;;SUICIDE ATTEMPT;;102
 ;;TRANSFUSION ERROR;;107
 Q