source: WorldVistAEHR/trunk/r/INCIDENT_REPORTING-QAN/QANCNV0.m@ 1046

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

initial load of WorldVistAEHR

File size: 2.9 KB
RevLine 
[613]1QANCNV0 ;HISC/GJC-Conversion of data from V1.01 to V2.0 ;2/5/92
2 ;;2.0;Incident Reporting;**1,2,4,5**;08/07/1992
3 ;
4EN0 ;CHECKING OLD IR DATA, SITE PARAMETER FILE, SET IR DATA AS NOT CONVERTED
5 S QANBAD=0
6 I '$D(^PRMQ(513.72,"B")) W !!,*7,"OLD INCIDENT REPORTING DATA NOT FOUND, EXITING THE CONVERSION!!",*7 S QANBAD=1 G EN2
7 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
8 K I F I=0:0 S I=$O(^PRMQ(513.72,I)) Q:I'>0 S $P(^(I,0),U,3)=""
9EN1 ; MAIN ENTRY FOR CONVERSION
10 K I W !!,"BEGINNING CONVERSION OF V1.01 DATA...."
11 ;***/ BEGIN KILL AND RE-INDEX THE "INC" X-REF /***
12 W !,"DELETING ""E"", AND ""INC"" X-REFS, FIELD: INCIDENT, FILE: 513.72" F DOT=1:1:10 W "." H 3
13 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
14 W !,"RE-INDEXING ""E"", AND ""INC"" X-REFS, FIELD: INCIDENT, FILE: 513.72" F DOT=1:1:10 W "." H 3
15 ;***/ END OF KILL AND RE-INDEX OF THE "INC" X-REF /***
16 S (PRMQIEN,QANXIT)=0
17 F S PRMQIEN=$O(^PRMQ(513.72,PRMQIEN)) Q:PRMQIEN'>0 K ^TMP($J) D CASE^QANCNV1 D:'QANXIT INCD D:'QANXIT PAT^QANCNVT
18 ;*** DATA CONVERSION CHECK ***
19 W !!,"BEGIN DATA CONVERSION CHECK: " F QAN=1:1:5 W "." H 3
20 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
21EN2 ;Echo conversion status, kill and quit.
22 W !!,"There was "_+$G(QANNON)_" non-Incident Reporting records."
23 W !!,"The data conversion has ",$S(QANBAD:"failed to convert ",1:"successfully converted ")_"all Incident Reporting",!,"records."
24 D KILL^QANCNV2
25 Q
26INCD ;** Create an entry in file 742.4 **
27 K DA,DD,DINUM,DLAYGO,DO
28 S DIC="^QA(742.4,",DIC(0)="LZ",X=QANCASE D FILE^DICN
29 K DA,DD,DINUM,DLAYGO,DO
30 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
31 S QANIEN(7424)=+Y ;In this routine, QANIEN(7424) is 742.4'S IEN
32 S QANNODE(7424)=$G(^QA(742.4,QANIEN(7424),0))
33 S $P(QANNODE(7424),U,2,5)=$G(QANINCD)_U_$G(QANDATE)_U_$G(QANLOC1)_U_$G(QANRPT)
34 S $P(QANNODE(7424),U,11)=$G(QANLVL),$P(QANNODE(7424),U,7)=$G(QANWT)
35 S $P(QANNODE(7424),U,8)=$S(PRMQDISP]""!($G(QANLVL(0))="CA"):0,1:1)
36 S $P(QANNODE(7424),U,15)=$S(PRMQDISP]""!($G(QANLVL(0))="CA"):0,1:1)
37 ;Test for special conditions here.
38 S $P(QANNODE(7424),U,16)=$S(PRMQINC=104:0,PRMQINC=105:1,1:"")
39 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)))
40 S ^QA(742.4,QANIEN(7424),0)=QANNODE(7424) ;Set the 'zero' node 742.4
41 D DESC^QANCNV2 ;Grab the incident description, if it exists.
42 I +$G(QANMED) S ^QA(742.4,QANIEN(7424),2,0)="^742.42S^1^1",^QA(742.4,QANIEN(7424),2,1,0)=QANMED
43 K DA,DIK S DIK="^QA(742.4,",DA=QANIEN(7424) D IX^DIK ;Set all x-ref's
44 K DA,DIK
45 Q
Note: See TracBrowser for help on using the repository browser.