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

QANCNV0 ;HISC/GJC-Conversion of data from V1.01 to V2.0 ;2/5/92
 ;;2.0;Incident Reporting;**1,2,4,5**;08/07/1992
 ;
EN0 ;CHECKING OLD IR DATA, SITE PARAMETER FILE, SET IR DATA AS NOT CONVERTED
 S QANBAD=0
 I '$D(^PRMQ(513.72,"B")) W !!,*7,"OLD INCIDENT REPORTING DATA NOT FOUND, EXITING THE CONVERSION!!",*7 S QANBAD=1 G EN2
 S QAQ0=$S($D(^QA(740,1,0))#2:^(0),1:"") I QAQ0="" W !!,*7,"QA SITE PARAMETERS FILE MISSING, CONTACT YOUR QA COORDINATOR!!",*7 S QANBAD=1 G EN2
 K I F I=0:0 S I=$O(^PRMQ(513.72,I)) Q:I'>0  S $P(^(I,0),U,3)=""
EN1 ; MAIN ENTRY FOR CONVERSION
 K I W !!,"BEGINNING CONVERSION OF V1.01 DATA...."
 ;***/ BEGIN KILL AND RE-INDEX THE "INC" X-REF /***
 W !,"DELETING ""E"", AND ""INC"" X-REFS, FIELD: INCIDENT,  FILE: 513.72" F DOT=1:1:10 W "." H 3
 K ^PRMQ(513.72,"INC"),^PRMQ(513.72,"E"),DIK S DIK="^PRMQ(513.72,",DIK(1)="15^E^INC" D ENALL^DIK K DIK
 W !,"RE-INDEXING ""E"", AND ""INC"" X-REFS, FIELD: INCIDENT,  FILE: 513.72" F DOT=1:1:10 W "." H 3
 ;***/ END OF KILL AND RE-INDEX OF THE "INC" X-REF /***
 S (PRMQIEN,QANXIT)=0
 F  S PRMQIEN=$O(^PRMQ(513.72,PRMQIEN)) Q:PRMQIEN'>0  K ^TMP($J) D CASE^QANCNV1 D:'QANXIT INCD D:'QANXIT PAT^QANCNVT
 ;*** DATA CONVERSION CHECK ***
 W !!,"BEGIN DATA CONVERSION CHECK: " F QAN=1:1:5 W "." H 3
 F QAN=0:0 S QAN=$O(^PRMQ(513.72,QAN)) Q:QAN'>0  I $P(^PRMQ(513.72,QAN,0),U,3)=1 S QANBAD=1 W !,*7,"Data for entry number: "_QAN_" has not been converted.",*7
EN2 ;Echo conversion status, kill and quit.
 W !!,"There was "_+$G(QANNON)_" non-Incident Reporting records."
 W !!,"The data conversion has ",$S(QANBAD:"failed to convert ",1:"successfully converted ")_"all Incident Reporting",!,"records."
 D KILL^QANCNV2
 Q
INCD ;** Create an entry in file 742.4 **
 K DA,DD,DINUM,DLAYGO,DO
 S DIC="^QA(742.4,",DIC(0)="LZ",X=QANCASE D FILE^DICN
 K DA,DD,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 S QANXIT=1 Q
 S QANIEN(7424)=+Y ;In this routine, QANIEN(7424) is 742.4'S IEN
 S QANNODE(7424)=$G(^QA(742.4,QANIEN(7424),0))
 S $P(QANNODE(7424),U,2,5)=$G(QANINCD)_U_$G(QANDATE)_U_$G(QANLOC1)_U_$G(QANRPT)
 S $P(QANNODE(7424),U,11)=$G(QANLVL),$P(QANNODE(7424),U,7)=$G(QANWT)
 S $P(QANNODE(7424),U,8)=$S(PRMQDISP]""!($G(QANLVL(0))="CA"):0,1:1)
 S $P(QANNODE(7424),U,15)=$S(PRMQDISP]""!($G(QANLVL(0))="CA"):0,1:1)
 ;Test for special conditions here.
 S $P(QANNODE(7424),U,16)=$S(PRMQINC=104:0,PRMQINC=105:1,1:"")
 S $P(QANNODE(7424),U,14)=$S(+PRMQINC=110:+$O(^QA(742.14,"BUPPER","OPERATING ROOM",0)),PRMQINC="111B"!(PRMQINC="111C"):+$O(^QA(742.14,"BUPPER","CONJUNCTION WITH A PROCEDURE",0)),1:+$O(^QA(742.14,"BUPPER","OTHER",0)))
 S ^QA(742.4,QANIEN(7424),0)=QANNODE(7424) ;Set the 'zero' node 742.4
 D DESC^QANCNV2 ;Grab the incident description, if it exists.
 I +$G(QANMED) S ^QA(742.4,QANIEN(7424),2,0)="^742.42S^1^1",^QA(742.4,QANIEN(7424),2,1,0)=QANMED
 K DA,DIK S DIK="^QA(742.4,",DA=QANIEN(7424) D IX^DIK ;Set all x-ref's
 K DA,DIK
 Q