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