source: WorldVistAEHR/trunk/r/PATIENT_REPRESENTATIVE-QAC/QACI2E.m@ 1593

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

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1QACI2E ; OAKOIFO/TKW - DATA MIGRATION - BUILD LEGACY DATA TO BE MIGRATED (CONT.) ;7/27/05 14:15
2 ;;2.0;Patient Representative;**19**;07/25/1995;Build 55
3 ;
4UPDCNT(PATSCNT) ; Update counts of data migrated on XTMP global
5 F TYPE="ROC","HL","USER","PT","CC","EMPINV","FSOS" D
6 . S ^XTMP("QACMIGR",TYPE,"U")=PATSCNT(TYPE)
7 . Q
8 Q
9 ;
10UPDERRCT ; Update counts of errors generated.
11 N CNT,I,TYPE
12 F TYPE="HL","USER","PT","CC","EMPINV","FSOS" D
13 . S CNT=0
14 . F I=0:0 S I=$O(^XTMP("QACMIGR",TYPE,"E",I)) Q:'I S CNT=CNT+1
15 . S ^XTMP("QACMIGR",TYPE,"E")=CNT Q
16 S CNT=0,I=""
17 F S I=$O(^XTMP("QACMIGR","ROC","E",I)) Q:I="" S CNT=CNT+1
18 S ^XTMP("QACMIGR","ROC","E")=CNT
19 Q
20 ;
21ERRPT(QACI0) ; Print all errors found during data migration
22 N PATSFROM
23 S PATSFROM=$S(QACI0:"Data Cleanup",1:"Move to Staging Area")
24ENERRPT ; Entry point to print all error reports found during any step of data migration.
25 N PATSTYPE,PATSHDR,PATSERR
26 S PATSERR=0
27 F PATSTYPE="HL","USER","PT","CC","EMPINV","FSOS" D Q:PATSERR
28 . I $O(^XTMP("QACMIGR",PATSTYPE,"E",0))]"" S PATSERR=1
29 . Q
30 I 'PATSERR W !!,"No Reference Table Errors were found",!
31 E D
32 . I $G(REPRINT),'$$ASK("Ref Table") Q
33 . W !!,"Printing report of Reference Table Errors",!
34 . S PATSHDR=PATSFROM_" - Ref Table Data Errors"
35 . N ZTSAVE S ZTSAVE("PATSHDR")=""
36 . D EN^XUTMDEVQ("DQRPT^QACI2E","Report - "_PATSHDR,.ZTSAVE)
37 . Q
38 I $O(^XTMP("QACMIGR","ROC","E",0))="" D Q
39 . W !!,"No Report of Contact (ROC) Errors were found",!
40 . Q
41 I $G(REPRINT),'$$ASK("ROC") Q
42 W !!,"Printing report of Report of Contact (ROC) Errors",!
43 S PATSTYPE="ROC"
44 S PATSHDR=PATSFROM_" - ROC Errors",PATSHDR(1)=" ROC Number Error"
45 K ZTSAVE S ZTSAVE("PATSTYPE")="",ZTSAVE("PATSHDR")=""
46 D EN^XUTMDEVQ("DQRPT^QACI1A","Report - "_PATSHDR,.ZTSAVE)
47 Q
48 ;
49ENRPT2 ; Print list of ROCs with data changed during migration
50 I $O(^XTMP("QACMIGR","ROC","C",""))="" D Q
51 . I $G(^XTMP("QACMIGR","ROC","U"))!($G(^("D"))) W !!,"No ROC data was changed when data was moved to staging area!",!! Q
52 . W !!,"ROC changes occur when data is moved to the staging area!"
53 . Q
54 W !!,"Ready to print the list of ROCs with data changed",!
55 N PATSHDR
56 S PATSHDR="ROCs With Data Changed for Migration",PATSHDR(1)=" ROC Number Data Changed"
57 N ZTSAVE S ZTSAVE("PATSHDR")=""
58 D EN^XUTMDEVQ("DQRPT3^QACI2E","Report of ROC Data Changed for Migration",.ZTSAVE)
59 Q
60 ;
61DQRPT ; Report errors found in reference table data
62 N PAGENO,LNCNT,LASTIEN,IEN,TYPE,ERRMSG,HDDATE,%,%H,%I
63 S PAGENO=1,LNCNT=0
64 D NOW^%DTC S HDDATE=$$FMTE^XLFDT(%)
65 U IO D HDR^QACI1A
66 S (LASTIEN,IEN)=""
67 F TYPE="HL","USER","PT","CC","EMPINV","FSOS" D
68 . Q:$O(^XTMP("QACMIGR",TYPE,"E",0))']""
69 . W !,$S(TYPE="HL":"Hospital Location",TYPE="USER":"User",TYPE="PT":"Patient",TYPE="CC":"Congressional Contact",TYPE="EMPINV":"Employee Involved",TYPE="FSOS":"Service/Discipline (Facility Service or Section)","":"*Unknown*")
70 . F IEN=0:0 S IEN=$O(^XTMP("QACMIGR",TYPE,"E",IEN)) Q:'IEN D
71 .. I LASTIEN'=IEN D
72 ... D:LNCNT>56 HDR^QACI1A
73 ... W !,"IEN: "_IEN
74 ... S LASTIEN=IEN,LNCNT=LNCNT+1
75 ... Q
76 .. F I=0:0 S I=$O(^XTMP("QACMIGR",TYPE,"E",IEN,I)) Q:'I S ERRMSG=^(I) D
77 ... D:LNCNT>58 HDR^QACI1A
78 ... W ?20,ERRMSG,!
79 ... S LNCNT=LNCNT+1 Q
80 .. Q
81 . Q
82 D ^%ZISC Q
83 ;
84DQRPT3 ; Print report of ROC data changed for migration
85 N PAGENO,LNCNT,ROCNO,PATSCHG,HDDATE,%,%H,%I,I
86 S PAGENO=1,LNCNT=0
87 D NOW^%DTC S HDDATE=$$FMTE^XLFDT(%)
88 U IO D HDR^QACI1A
89 S ROCNO=""
90 F S ROCNO=$O(^XTMP("QACMIGR","ROC","C",ROCNO)) Q:ROCNO="" S PATSCHG=^(ROCNO) D
91 . D:LNCNT>56 HDR^QACI1A
92 . W !," "_ROCNO S I=16
93 . I $P(PATSCHG,"^")=1 W ?I,"Info Taken By" S I=I+16
94 . I $P(PATSCHG,"^",2)=1 W ?I,"Edited By" S I=I+16
95 . I $P(PATSCHG,"^",3)=1 W ?I,"Division" S I=I+16
96 . I $P(PATSCHG,"^",4)=1 W ?I,"Issue Text" S I=I+16
97 . I $P(PATSCHG,"^",5)=1 W ?I,"Issue Text Overflow"
98 . W ! S LNCNT=LNCNT+1
99 . Q
100 D ^%ZISC
101 Q
102 ;
103ENREPRNT ; Reprint data error reports - menu entry point
104 N PATSFROM,CNT,REPRINT
105 S CNT=0,REPRINT=1
106 F PATSTYPE="ROC","HL","USER","PT","CC","EMPINV","FSOS" D Q:CNT
107 . I $O(^XTMP("QACMIGR",PATSTYPE,"U",0))]"" S CNT=1 Q
108 . I $O(^XTMP("QACMIGR",PATSTYPE,"D",0))]"" S CNT=1
109 . Q
110 S PATSFROM=$S(CNT=1:"Data Cleanup",1:"Move to Staging Area")
111 D ENERRPT
112 Q
113 ;
114ASK(TYPE) ; Ask whether users want to reprint error reports
115 N DIR,X,Y
116 S DIR("A")="Reprint the "_TYPE_" error report"
117 S DIR(0)="YO",DIR("B")="YES"
118 D ^DIR
119 Q Y
120 ;
121 ;
Note: See TracBrowser for help on using the repository browser.