138 lines
5.6 KiB
Mathematica
138 lines
5.6 KiB
Mathematica
QACI2C ; OAKOIFO/TKW - DATA MIGRATION - BUILD LEGACY DATA TO BE MIGRATED (CONT.) ;5/1/06 12:09
|
|
;;2.0;Patient Representative;**19**;07/25/1995;Build 55
|
|
TXTERR(FLD,LEN,REMOVEUP,NOTNULL) ; Check field for length, check for control characters
|
|
; FLD=Field to be checked, LEN=optional max length
|
|
; REMOVEUP=optional flag set to 1 to remove up-arrows from the text.
|
|
; NOTNULL=optional flag set to 1 if field cannot be null.
|
|
; Return 1 if any errors are encountered.
|
|
N L,I,X,Y,ERR S REMOVEUP=$G(REMOVEUP)
|
|
S L=$L(FLD),ERR=0
|
|
I $G(LEN),L>LEN Q 1
|
|
F I=1:1:L S X=$E(FLD,I,I) Q:ERR!(X="") D
|
|
. I REMOVEUP,X="^" S FLD=$E(FLD,1,I-1)_$E(FLD,I+1,L),I=I-1 Q
|
|
. S Y=$A(X)
|
|
. I Y>31,Y<127 Q
|
|
. S ERR=1 Q
|
|
I $G(NOTNULL),FLD="" Q 1
|
|
Q ERR
|
|
;
|
|
CONVROC(OLDROC) ; Convert roc number to new format
|
|
I OLDROC'?3N.AN1"."6N Q ""
|
|
N NEWROC,X
|
|
; Make sure the first part of the ROC number is a valid station number
|
|
S X=$P(OLDROC,".") Q:X="" ""
|
|
I '$$LKUP^XUAF4(X) Q ""
|
|
; Convert the fiscal year part of the ROC number to 4 digits
|
|
S X=$E($P(OLDROC,".",2),1,2)
|
|
S X=$S(+X>9:"19"_X,1:"20"_X)
|
|
; Build the new ROC number, adding one more digit to the sequential counter part of the ROC number.
|
|
S NEWROC=$P(OLDROC,".")_"."_X_"0"_$E($P(OLDROC,".",2),3,6)
|
|
Q NEWROC
|
|
;
|
|
ENDELALL(PATSBY) ; Wipe out list of previously migrated reference table data
|
|
F TYPE="ROC","HL","USER","PT","CC","EMPINV","FSOS" K ^XTMP("QACMIGR",TYPE,"D")
|
|
S PATSBY=1
|
|
Q
|
|
;
|
|
BLDTXT(ROCNO,ROCIEN,QACI0,ROCCNT,RESERR,EDITITXT,EDITRTXT) ; Build issue and resolution text into output global
|
|
; Issue Text
|
|
N I,X,ITXTCNT,ITXTLN,ITXTLONG,OLDROC,RESERR1,RESERR2
|
|
I QACI0 N ROCCNT
|
|
S ROCCNT=1,(ITXTCNT,ITXTLN,ITXTLONG)=0
|
|
S OLDROC=$P(^QA(745.1,ROCIEN,0),"^")
|
|
F I=0:0 S I=$O(^QA(745.1,ROCIEN,4,I)) Q:'I!(ITXTLONG) S X=$G(^(I,0)) D
|
|
. I $E(X,$L(X))'=" " S X=X_" "
|
|
. I $$TXTERR(.X,256,1) D ERROC^QACI2A(OLDROC,"Issue Text node "_I_" too long or contains invalid characters") Q
|
|
. I (ITXTCNT+$L(X))>3950 D Q
|
|
.. S ITXTCNT=ITXTCNT+43,ITXTLONG=1
|
|
.. Q:QACI0
|
|
.. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+1)=ROCNO_"^ITXT^ ",^(ROCCNT+2)=ROCNO_"^ITXT^ "
|
|
.. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+3)=ROCNO_"^ITXT^ **** Continued in Resolution Text ****"
|
|
.. S ROCCNT=ROCCNT+3
|
|
.. Q
|
|
. S ITXTCNT=ITXTCNT+$L(X)
|
|
. S ITXTLN=I
|
|
. ; If called from ^QACI0, we just need to check the text, not save it.
|
|
. Q:QACI0
|
|
. S ROCCNT=ROCCNT+1
|
|
. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT)=ROCNO_"^ITXT^"_X
|
|
. Q
|
|
;If there was no issue text, set one line of text for migration.
|
|
I ROCCNT=1,'QACI0 D
|
|
. S ROCCNT=2,EDITITXT=1
|
|
. 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."
|
|
. Q
|
|
;
|
|
; Resolution Text
|
|
S RESERR1="Resolution Text",RESERR2=" char.(8000 maximum)"
|
|
S RESERR="0^"_RESERR1
|
|
N RTXTCNT S RTXTCNT=0
|
|
F I=0:0 S I=$O(^QA(745.1,ROCIEN,6,I)) Q:'I S X=$G(^(I,0)) D
|
|
. I $E(X,$L(X))'=" " S X=X_" "
|
|
. S RTXTCNT=RTXTCNT+$L(X)
|
|
. I $$TXTERR(.X,256,1) D ERROC^QACI2A(OLDROC,"Resolution Text Node "_I_" too long or contains invalid characters") Q
|
|
. ; If resolution text is too long, quit, but keep track of total length.
|
|
. Q:RTXTCNT>8000
|
|
. ; If called from ^QACI0, just check for errors, don't save text.
|
|
. Q:QACI0
|
|
. S ROCCNT=ROCCNT+1
|
|
. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT)=ROCNO_"^RTXT^"_X
|
|
. Q
|
|
S RESERR=RTXTCNT_"^"_RESERR1
|
|
I RTXTCNT>8000 D ERROC^QACI2A(OLDROC,RESERR1_"="_RTXTCNT_RESERR2)
|
|
;
|
|
; If issue text was too long, store it in the resolution text for migration
|
|
I ITXTLONG D
|
|
. S RESERR1="Resolution + overflow issue text"
|
|
. S RTXTCNT=RTXTCNT+76
|
|
. I 'QACI0,RTXTCNT'>8000 D
|
|
.. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+1)=ROCNO_"^RTXT^ ",^(ROCCNT+2)=ROCNO_"^RTXT^ "
|
|
.. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+3)=ROCNO_"^RTXT^ **** (continued) Issue Text transferred during Data Migration ****"
|
|
.. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+4)=ROCNO_"^RTXT^ "
|
|
.. S ROCCNT=ROCCNT+4,EDITRTXT=1
|
|
.. Q
|
|
. ; Read through remaining issue text and append it to resolution text.
|
|
. F I=ITXTLN:0 S I=$O(^QA(745.1,ROCIEN,4,I)) Q:'I S X=$G(^(I,0)) D
|
|
.. I $E(X,$L(X))'=" " S X=X_" "
|
|
.. S RTXTCNT=RTXTCNT+$L(X)
|
|
.. I $$TXTERR(.X,256,1) D ERROC^QACI2A(OLDROC,"Issue Text Node "_I_" too long or contains invalid characters") Q
|
|
.. I QACI0!(RTXTCNT>8000) Q
|
|
.. S ROCCNT=ROCCNT+1
|
|
.. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT)=ROCNO_"^RTXT^"_X
|
|
.. Q
|
|
. S RTXTCNT=RTXTCNT+42
|
|
. S RESERR=RTXTCNT_"^"_RESERR1
|
|
. I RTXTCNT>8000 D ERROC^QACI2A(OLDROC,RESERR1_"="_RTXTCNT_RESERR2) Q
|
|
. Q:QACI0
|
|
. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+1)=ROCNO_"^RTXT^ ",^(ROCCNT+2)=ROCNO_"^RTXT^ "
|
|
. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+3)=ROCNO_"^RTXT^ **** End of overflow Issue Text ****"
|
|
. S ROCCNT=ROCCNT+3
|
|
. Q
|
|
; Store REFER CONTACT TO list in resolution text.
|
|
Q:'$O(^QA(745.1,ROCIEN,11,0))
|
|
S RESERR1=RESERR1_" + Refer To"
|
|
S RTXTCNT=RTXTCNT+24
|
|
I 'QACI0 D
|
|
. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+1)=ROCNO_"^RTXT^ ",^(ROCCNT+2)=ROCNO_"^RTXT^ "
|
|
. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+3)=ROCNO_"^RTXT^** REFER CONTACT TO **"
|
|
. S ROCCNT=ROCCNT+3
|
|
. Q
|
|
F I=0:0 S I=$O(^QA(745.1,ROCIEN,11,I)) Q:'I S X=+$G(^(I,0)) D
|
|
. S X=$P($G(^VA(200,X,0)),"^")
|
|
. S RTXTCNT=RTXTCNT+$L(X)+2
|
|
. Q:QACI0!(RTXTCNT>8000)
|
|
. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+1)=ROCNO_"^RTXT^ "
|
|
. S ^XTMP("QACMIGR","ROC","U",ROCNO_" ",ROCCNT+2)=ROCNO_"^RTXT^ "_X
|
|
. S ROCCNT=ROCCNT+2
|
|
. Q
|
|
S RESERR=RTXTCNT_"^"_RESERR1
|
|
I RTXTCNT>8000 D ERROC^QACI2A(OLDROC,RESERR1_"="_RTXTCNT_RESERR2)
|
|
Q
|
|
;
|
|
ERREF(TYPE,IEN,MSG) ; Record an error on Reference Table Data
|
|
N ERRCNT S ERRCNT=$O(^XTMP("QACMIGR",TYPE,"E",IEN,"A"),-1)+1
|
|
S ^XTMP("QACMIGR",TYPE,"E",IEN,ERRCNT)=MSG Q
|
|
;
|
|
;
|
|
;
|