46 lines
2.9 KiB
Mathematica
46 lines
2.9 KiB
Mathematica
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
|