source: WorldVistAEHR/trunk/r/INCIDENT_REPORTING-QAN/QANCNV00.m@ 724

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1QANCNV00 ;HISC/GJC-Conversion of data from V1.01 to V2.0 ;10/7/92
2 ;;2.0;Incident Reporting;**1,2**;08/07/1992
3 ;
4EN0 ;Check file 513.73 for the existance of data.
5 ; *** Variable list ***
6 ; EXIST ---> Boolean, does incident data exist in global 513.72?
7 ; QAFLG ---> Boolean, do we wish to purge converted records?
8 ; QAFOUND ---> Boolean, do converted records exist?
9 ;
10 S QAFOUND=0
11 I '$D(^PRMQ(513.72,"E")),('$D(^PRMQ(513.72,"INC"))) S EXIST=0
12 E S EXIST=1
13 D:'EXIST DELETE ;Check for converted records, if found, ask to delete.
14 I 'EXIST,(QAFOUND),($D(QAFLG)),(QAFLG) D PURGE ;If data does not exist,
15 ;and converted records are found, and we wish to purge, do the purge.
16 I 'EXIST W !?5,$S(+$G(QAFLG):"Converted records were deleted.",1:"No data to be converted, no action taken.") D EXIT Q ;With no data to convert, kill variables and quit.
17 ;
18 ;We know we have data, "E" and "INC" are xrefs on the same field.
19 ;Both exist or neither exist.
20 ;
21 D EXIT S QAFOUND=0,EXIST=1 D DELETE ;Check if old converted records xist.
22 Q:$D(DIRUT)!($D(DIROUT))
23 I 'QAFOUND D CONVERT,EXIT Q
24 I QAFOUND,($D(QAFLG)),(QAFLG) D PURGE,^QANCNV0
25 I QAFOUND,($D(QAFLG)),('QAFLG) D DELUTL
26EXIT ;Kill and quit.
27 K DA,DIK,DIR,EXIST,QA,QACONV,QAFLG,QAFOUND,QB,QC,X,Y
28 Q
29CONVERT ;Ask for a first time conversion.
30 K DIR S DIR(0)="Y",DIR("B")="No",DIR("?")="Enter 'N' for no, 'Y' for yes."
31 S DIR("A")="Do you wish to convert old Incident Reporting data"
32 D ^DIR K DIR S QACONV=+Y Q:$D(DIRUT)!($D(DIROUT))
33 W ! D:'QACONV DELUTL D:QACONV ^QANCNV0
34 Q
35DELETE ;Check if any converted records exist.
36 S QA=""
37 F S QA=$O(^QA(742.4,"B",QA)) Q:QA=""!(QAFOUND) D
38 . S QA("FIRST")=$P(QA,".") Q:QA("FIRST")']""
39 . I $E(QA("FIRST"),$L(QA("FIRST")))?1A S QAFOUND=1 D
40 .. K DIR S DIR(0)="Y"
41 .. S DIR("A")="Do you wish to delete converted data"_$S(EXIST:" and reconvert",1:"")
42 .. S DIR("B")="No",DIR("?")="Enter 'N' for no, 'Y' for yes." D ^DIR
43 .. K DIR S QAFLG=+Y W !
44 .. Q
45 . Q
46 Q
47DELUTL ;Delete utility for IR data in '^PRMQ(513.72'.
48 K DIR
49 S DIR(0)="Y",DIR("B")="No",DIR("?")="Enter 'N' for no, 'Y' for yes."
50 S DIR("A",1)="Are you sure about your decision to delete Incident Reporting"
51 S DIR("A")="data from the '^PRMQ(513.72' global" D ^DIR K DIR W !
52 Q:+Y'>0
53 F QA=0:0 S QA=$O(^PRMQ(513.72,"E",QA)) Q:QA'>0 D
54 . F QB=0:0 S QA=$O(^PRMQ(513.72,"E",QA,QB)) Q:QB'>0 D
55 .. W !?5,"Deleting data global: ^PRMQ(513.72,"_QB_",0)"
56 .. K DA,DIK S DA=QB,DIK="^PRMQ(513.72," D ^DIK K DA,DIK
57 .. Q
58 . Q
59 Q
60PURGE ;Delete converted records form files: 742 and 742.4.
61 K QA,QB,QC S QA=""
62 F S QA=$O(^QA(742.4,"B",QA)) Q:QA="" D
63 . S QA("FIRST")=$P(QA,".") Q:QA("FIRST")']""
64 . Q:$E(QA("FIRST"),$L(QA("FIRST")))'?1A ;Quit if not converted.
65 . F QB=0:0 S QB=$O(^QA(742.4,"B",QA,QB)) Q:QB'>0 D
66 .. N QA F QC=0:0 S QC=$O(^QA(742,"BCS",QB,QC)) Q:QC'>0 D
67 ... W !!,"Killing data global ^QA(742,"_QC_",0)"
68 ... K DA,DIK S DA=QC,DIK="^QA(742," D ^DIK K DA,DIK
69 ... W !,"Killing data global ^QA(742.4,"_QB_",0)"
70 ... K DA,DIK S DA=QB,DIK="^QA(742.4," D ^DIK K DA,DIK
71 ... K:$D(^QA(742.4,"ACN",QC,QB)) ^QA(742.4,"ACN",QC,QB)
72 ... I $D(^QA(740.5,"AA",742,QC))\10 S DA=+$O(^QA(740.5,"AA",742,QC,0))
73 ... I S DIK="^QA(740.5," W:DA>0 !,"Deleting the QA Audit file entry: ^QA(740.5,"_DA_",0)" D:DA>0 ^DIK K DA,DIK
74 ... I $D(^QA(740.5,"AA",742.4,QB))\10 S DA=+$O(^QA(740.5,"AA",742.4,QB,0))
75 ... I S DIK="^QA(740.5," W:DA>0 !,"Deleting the QA Audit file entry: ^QA(740.5,"_DA_",0)" D:DA>0 ^DIK K DA,DIK
76 ... Q
77 .. Q
78 . Q
79 Q
Note: See TracBrowser for help on using the repository browser.