source: WorldVistAEHR/trunk/r/PATIENT_REPRESENTATIVE-QAC/QACI2C.m@ 1716

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

initial load of WorldVistAEHR

File size: 5.6 KB
RevLine 
[613]1QACI2C ; OAKOIFO/TKW - DATA MIGRATION - BUILD LEGACY DATA TO BE MIGRATED (CONT.) ;5/1/06 12:09
2 ;;2.0;Patient Representative;**19**;07/25/1995;Build 55
3TXTERR(FLD,LEN,REMOVEUP,NOTNULL) ; Check field for length, check for control characters
4 ; FLD=Field to be checked, LEN=optional max length
5 ; REMOVEUP=optional flag set to 1 to remove up-arrows from the text.
6 ; NOTNULL=optional flag set to 1 if field cannot be null.
7 ; Return 1 if any errors are encountered.
8 N L,I,X,Y,ERR S REMOVEUP=$G(REMOVEUP)
9 S L=$L(FLD),ERR=0
10 I $G(LEN),L>LEN Q 1
11 F I=1:1:L S X=$E(FLD,I,I) Q:ERR!(X="") D
12 . I REMOVEUP,X="^" S FLD=$E(FLD,1,I-1)_$E(FLD,I+1,L),I=I-1 Q
13 . S Y=$A(X)
14 . I Y>31,Y<127 Q
15 . S ERR=1 Q
16 I $G(NOTNULL),FLD="" Q 1
17 Q ERR
18 ;
19CONVROC(OLDROC) ; Convert roc number to new format
20 I OLDROC'?3N.AN1"."6N Q ""
21 N NEWROC,X
22 ; Make sure the first part of the ROC number is a valid station number
23 S X=$P(OLDROC,".") Q:X="" ""
24 I '$$LKUP^XUAF4(X) Q ""
25 ; Convert the fiscal year part of the ROC number to 4 digits
26 S X=$E($P(OLDROC,".",2),1,2)
27 S X=$S(+X>9:"19"_X,1:"20"_X)
28 ; Build the new ROC number, adding one more digit to the sequential counter part of the ROC number.
29 S NEWROC=$P(OLDROC,".")_"."_X_"0"_$E($P(OLDROC,".",2),3,6)
30 Q NEWROC
31 ;
32ENDELALL(PATSBY) ; Wipe out list of previously migrated reference table data
33 F TYPE="ROC","HL","USER","PT","CC","EMPINV","FSOS" K ^XTMP("QACMIGR",TYPE,"D")
34 S PATSBY=1
35 Q
36 ;
37BLDTXT(ROCNO,ROCIEN,QACI0,ROCCNT,RESERR,EDITITXT,EDITRTXT) ; Build issue and resolution text into output global
38 ; Issue Text
39 N I,X,ITXTCNT,ITXTLN,ITXTLONG,OLDROC,RESERR1,RESERR2
40 I QACI0 N ROCCNT
41 S ROCCNT=1,(ITXTCNT,ITXTLN,ITXTLONG)=0
42 S OLDROC=$P(^QA(745.1,ROCIEN,0),"^")
43 F I=0:0 S I=$O(^QA(745.1,ROCIEN,4,I)) Q:'I!(ITXTLONG) S X=$G(^(I,0)) D
44 . I $E(X,$L(X))'=" " S X=X_" "
45 . I $$TXTERR(.X,256,1) D ERROC^QACI2A(OLDROC,"Issue Text node "_I_" too long or contains invalid characters") Q
46 . I (ITXTCNT+$L(X))>3950 D Q
47 .. S ITXTCNT=ITXTCNT+43,ITXTLONG=1
48 .. Q:QACI0
49 .. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+1)=ROCNO_"^ITXT^ ",^(ROCCNT+2)=ROCNO_"^ITXT^ "
50 .. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+3)=ROCNO_"^ITXT^ **** Continued in Resolution Text ****"
51 .. S ROCCNT=ROCCNT+3
52 .. Q
53 . S ITXTCNT=ITXTCNT+$L(X)
54 . S ITXTLN=I
55 . ; If called from ^QACI0, we just need to check the text, not save it.
56 . Q:QACI0
57 . S ROCCNT=ROCCNT+1
58 . S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT)=ROCNO_"^ITXT^"_X
59 . Q
60 ;If there was no issue text, set one line of text for migration.
61 I ROCCNT=1,'QACI0 D
62 . S ROCCNT=2,EDITITXT=1
63 . S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",2)=ROCNO_"^ITXT^No data present in this field during migration from Patient Rep. Text required for closed ROCs in PATS."
64 . Q
65 ;
66 ; Resolution Text
67 S RESERR1="Resolution Text",RESERR2=" char.(8000 maximum)"
68 S RESERR="0^"_RESERR1
69 N RTXTCNT S RTXTCNT=0
70 F I=0:0 S I=$O(^QA(745.1,ROCIEN,6,I)) Q:'I S X=$G(^(I,0)) D
71 . I $E(X,$L(X))'=" " S X=X_" "
72 . S RTXTCNT=RTXTCNT+$L(X)
73 . I $$TXTERR(.X,256,1) D ERROC^QACI2A(OLDROC,"Resolution Text Node "_I_" too long or contains invalid characters") Q
74 . ; If resolution text is too long, quit, but keep track of total length.
75 . Q:RTXTCNT>8000
76 . ; If called from ^QACI0, just check for errors, don't save text.
77 . Q:QACI0
78 . S ROCCNT=ROCCNT+1
79 . S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT)=ROCNO_"^RTXT^"_X
80 . Q
81 S RESERR=RTXTCNT_"^"_RESERR1
82 I RTXTCNT>8000 D ERROC^QACI2A(OLDROC,RESERR1_"="_RTXTCNT_RESERR2)
83 ;
84 ; If issue text was too long, store it in the resolution text for migration
85 I ITXTLONG D
86 . S RESERR1="Resolution + overflow issue text"
87 . S RTXTCNT=RTXTCNT+76
88 . I 'QACI0,RTXTCNT'>8000 D
89 .. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+1)=ROCNO_"^RTXT^ ",^(ROCCNT+2)=ROCNO_"^RTXT^ "
90 .. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+3)=ROCNO_"^RTXT^ **** (continued) Issue Text transferred during Data Migration ****"
91 .. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+4)=ROCNO_"^RTXT^ "
92 .. S ROCCNT=ROCCNT+4,EDITRTXT=1
93 .. Q
94 . ; Read through remaining issue text and append it to resolution text.
95 . F I=ITXTLN:0 S I=$O(^QA(745.1,ROCIEN,4,I)) Q:'I S X=$G(^(I,0)) D
96 .. I $E(X,$L(X))'=" " S X=X_" "
97 .. S RTXTCNT=RTXTCNT+$L(X)
98 .. I $$TXTERR(.X,256,1) D ERROC^QACI2A(OLDROC,"Issue Text Node "_I_" too long or contains invalid characters") Q
99 .. I QACI0!(RTXTCNT>8000) Q
100 .. S ROCCNT=ROCCNT+1
101 .. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT)=ROCNO_"^RTXT^"_X
102 .. Q
103 . S RTXTCNT=RTXTCNT+42
104 . S RESERR=RTXTCNT_"^"_RESERR1
105 . I RTXTCNT>8000 D ERROC^QACI2A(OLDROC,RESERR1_"="_RTXTCNT_RESERR2) Q
106 . Q:QACI0
107 . S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+1)=ROCNO_"^RTXT^ ",^(ROCCNT+2)=ROCNO_"^RTXT^ "
108 . S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+3)=ROCNO_"^RTXT^ **** End of overflow Issue Text ****"
109 . S ROCCNT=ROCCNT+3
110 . Q
111 ; Store REFER CONTACT TO list in resolution text.
112 Q:'$O(^QA(745.1,ROCIEN,11,0))
113 S RESERR1=RESERR1_" + Refer To"
114 S RTXTCNT=RTXTCNT+24
115 I 'QACI0 D
116 . S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+1)=ROCNO_"^RTXT^ ",^(ROCCNT+2)=ROCNO_"^RTXT^ "
117 . S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+3)=ROCNO_"^RTXT^** REFER CONTACT TO **"
118 . S ROCCNT=ROCCNT+3
119 . Q
120 F I=0:0 S I=$O(^QA(745.1,ROCIEN,11,I)) Q:'I S X=+$G(^(I,0)) D
121 . S X=$P($G(^VA(200,X,0)),"^")
122 . S RTXTCNT=RTXTCNT+$L(X)+2
123 . Q:QACI0!(RTXTCNT>8000)
124 . S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+1)=ROCNO_"^RTXT^ "
125 . S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+2)=ROCNO_"^RTXT^ "_X
126 . S ROCCNT=ROCCNT+2
127 . Q
128 S RESERR=RTXTCNT_"^"_RESERR1
129 I RTXTCNT>8000 D ERROC^QACI2A(OLDROC,RESERR1_"="_RTXTCNT_RESERR2)
130 Q
131 ;
132ERREF(TYPE,IEN,MSG) ; Record an error on Reference Table Data
133 N ERRCNT S ERRCNT=$O(^XTMP("QACMIGR",TYPE,"E",IEN,"A"),-1)+1
134 S ^XTMP("QACMIGR",TYPE,"E",IEN,ERRCNT)=MSG Q
135 ;
136 ;
137 ;
Note: See TracBrowser for help on using the repository browser.