166 lines
7.0 KiB
Mathematica
166 lines
7.0 KiB
Mathematica
TIUPEFIX ; SLC/JER - Resolve Filing errors for TIU Documents ;11/01/03
|
|
;;1.0;TEXT INTEGRATION UTILITIES;**1,21,100,167,113,112**;Jun 20, 1997
|
|
MAKE(SUCCESS,DFN,TITLE,TIU,TIUBUF) ; File new TIU Document
|
|
; SUCCESS = (by ref) SUCCESS Returns TIU DOCUMENT # (PTR to 8925)
|
|
; = 0^Explanatory message if no SUCCESS
|
|
; DFN = Patient (#2)
|
|
; TITLE = Pointer to TIU Document Definition (#8925.1)
|
|
; TIU = Array of demographic and visit attributes
|
|
; TIUBUF = Record number (ien) of entry in TIU Buffer file (#8925.2)
|
|
;
|
|
; -- first, get TIU Document record --
|
|
;
|
|
N TIUDA,LDT,NEWREC,TIUX,TIUTYP,TIUDPRM,HAPPY,TIUCLASS,TIUDTYP,TIUPOST
|
|
N TIUDFLT,TIUREC
|
|
S SUCCESS=0 ; Initialize SUCCESS to false
|
|
I $S($D(TIU)'>9:1,+$G(DFN)'>0:1,+$G(TIUTYPE)'>0:1,1:0) S SUCCESS="0^"_$$EZBLD^DIALOG(89250001) Q
|
|
; If target file is not 8925 QUIT
|
|
I +$G(^TIU(8925.1,+TIUTYPE,1))'=8925 Q
|
|
S TIUDTYP=$P($G(^TIU(8925.1,+TIUTYPE,0)),U,4)
|
|
S TIUCLASS=$S(TIUDTYP="CL":+TIUTYPE,1:38)
|
|
S TIUDFLT=$S(TIUCLASS'=TIUTYPE:TIUTYPE,1:"")
|
|
I +$G(TITLE)'>0 S TITLE=$$ASKTITLE^TIULA3(TIUCLASS,TIUDFLT)
|
|
Q:+TITLE'>0
|
|
S TIUTYP=TITLE,TIUTYP(1)=1_U_TITLE
|
|
D DOCPRM^TIULC1(TITLE,.TIUDPRM)
|
|
;S TIUDA=$$GETREC^TIUEDI1(DFN,.TIU,1,.NEWREC,.TIUDPRM) ;10/27/00
|
|
S TIUDA=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.NEWREC,.TIUDPRM)
|
|
I +TIUDA'>0 S SUCCESS="0^"_$$EZBLD^DIALOG(89250002) Q
|
|
I +$$CANEDIT^TIUPUTU(TIUDA)'>0 D G MAKEX
|
|
. D MAKEADD(.TIUADD,+TIUDA,TIUBUF) S SUCCESS=TIUADD
|
|
S SUCCESS=1
|
|
;
|
|
; -- second, load the header elements & text into TIUX array
|
|
;
|
|
D STUFREC(TIUDA,$G(DFN),$P($G(^TIU(8925,TIUDA,0)),U,6),.TIU)
|
|
D LOADTIUX(.TIUX,TIUBUF)
|
|
;
|
|
; -- third, file the data in TIU Document record --
|
|
;
|
|
K ^TIU(8925,+TIUDA,"TEMP"),TIUX(.01),TIUX(.02),TIUX(.03),TIUX(.05)
|
|
K TIUX(.13),TIUX(1205),TIUX(1211)
|
|
M ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT") K TIUX("TEXT")
|
|
D FILE(.HAPPY,+TIUDA,.TIUX,TIUTYP)
|
|
D MERGTEXT^TIUEDI1(+TIUDA,.TIU)
|
|
S TIUPOST=$$POSTFILE^TIULC1(TITLE)
|
|
S TIUREC("#")=TIUDA
|
|
I TIUPOST]"" X TIUPOST
|
|
MAKEX D ALERTDEL^TIUPEVNT(+TIUBUF)
|
|
D RESOLVE^TIUPEVNT($S($D(XQADATA):+$P(XQADATA,";",3),1:$G(ERRDA)),1)
|
|
D BUFPURGE^TIUPUTC(+TIUBUF)
|
|
K ^TIU(8925,+TIUDA,"TEMP") W "Done."
|
|
I +$G(TIUDA),+$D(^TIU(8925,+$G(TIUDA),0)) D
|
|
. N TIU D GETTIU^TIULD(.TIU,+TIUDA)
|
|
. D EN^VALM("TIU BROWSE FOR MRT")
|
|
Q
|
|
LOADTIUX(TIUARR,TIUBUF) ; Load TIUX array with header and text
|
|
N TIUI,TIUHSIG,TIUBGN,TIULINE,X,Y,TYPE I '$D(TIUPRM0) D SETPARM^TIULE
|
|
S TIUHSIG=$P(TIUPRM0,U,10),TIUBGN=$P(TIUPRM0,U,12)
|
|
S TIUI=0 F S TIUI=$O(^TIU(8925.2,+TIUBUF,"TEXT",TIUI)) Q:+TIUI'>0 D
|
|
. S TIULINE=$G(^TIU(8925.2,+TIUBUF,"TEXT",TIUI,0))
|
|
. I TIULINE[TIUHSIG D
|
|
. . N TIUD1,TIUD4
|
|
. . S X=$$STRIP^TIULS($P(TIULINE,":",2)),Y=$$WHATYPE^TIUPUTU(X)
|
|
. . I +Y'>0 D MAIN^TIUPEVNT(TIUBUF,1,3,X) Q
|
|
. . S TIUD1=$G(^TIU(8925.1,+Y,1)),TIUD4=$G(^TIU(8925.1,+Y,4))
|
|
. . S TYPE=+Y
|
|
. . F D Q:TIULINE[TIUBGN!(+TIUI'>0)
|
|
. . . N TIUN,TIUCAP,TIUFLD,TIUREQ S TIUREQ=0
|
|
. . . S TIUI=$O(^TIU(8925.2,+TIUBUF,"TEXT",TIUI)) Q:+TIUI'>0
|
|
. . . S TIULINE=$G(^TIU(8925.2,+TIUBUF,"TEXT",TIUI,0)) Q:TIULINE[TIUBGN
|
|
. . . S TIUCAP=$P(TIULINE,":") Q:TIUCAP']""
|
|
. . . S TIUN=$O(^TIU(8925.1,+TYPE,"HEAD","B",TIUCAP,0))
|
|
. . . Q:+TIUN'>0
|
|
. . . S TIUFLD=$P(^TIU(8925.1,+TYPE,"HEAD",+TIUN,0),U,3)
|
|
. . . Q:TIUFLD']""
|
|
. . . S TIUREQ=$P(^TIU(8925.1,+TYPE,"HEAD",+TIUN,0),U,7)
|
|
. . . S TIUARR(TIUFLD)=$$STRIP^TIULS($P(TIULINE,":",2,99))
|
|
. . . S:TIUFLD'=.001 TIUARR(TIUFLD)=$$TRNSFRM(+TYPE,TIUFLD,TIUARR(TIUFLD))
|
|
. . . I +TIUREQ,TIUARR(TIUFLD)="" S TIUARR(TIUFLD)="** REQUIRED FIELD MISSING FROM UPLOAD **"
|
|
. . . I $S(TIUFLD=.01:1,TIUFLD=.02:1,TIUFLD=.07:1,TIUFLD=1301:1,1:0) K TIUARR(TIUFLD)
|
|
. . I TIULINE[TIUBGN D
|
|
. . . N TIUJ S TIUJ=0
|
|
. . . F D Q:+TIUI'>0
|
|
. . . . S TIUI=$O(^TIU(8925.2,+TIUBUF,"TEXT",TIUI)) Q:+TIUI'>0
|
|
. . . . S TIUJ=TIUJ+1
|
|
. . . . S TIUARR("TEXT",TIUJ,0)=$G(^TIU(8925.2,+TIUBUF,"TEXT",TIUI,0))
|
|
Q
|
|
STUFREC(DA,DFN,PARENT,TIU) ; Stuff fixed field data
|
|
N FDA,FDARR,IENS,FLAGS,TIUMSG,TIURDT
|
|
S IENS=""""_DA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS="K"
|
|
I +$G(PARENT)'>0 D
|
|
. S @FDARR@(.02)=$G(DFN),@FDARR@(.03)=$P($G(TIU("VISIT")),U)
|
|
. S @FDARR@(.05)=$S(+$$REQVER(+$P($G(TIUDPRM(0)),U,3)):4,1:5)
|
|
. S @FDARR@(.07)=$P(TIU("EDT"),U)
|
|
. S @FDARR@(.08)=$P(TIU("LDT"),U),@FDARR@(1401)=$P($G(TIU("AD#")),U)
|
|
. S @FDARR@(1402)=$P($G(TIU("TS")),U),@FDARR@(1201)=$$NOW^TIULC
|
|
. S @FDARR@(1205)=$S(+$P($G(TIU("LOC")),U):$P($G(TIU("LOC")),U),1:$P($G(TIU("VLOC")),U))
|
|
. S @FDARR@(1212)=$S(+$P($G(TIU("INST")),U):$P($G(TIU("INST")),U),1:DUZ(2))
|
|
. S @FDARR@(1404)=$P($G(TIU("SVC")),U)
|
|
I +$G(PARENT)>0 D
|
|
. S @FDARR@(.02)=+$P(^TIU(8925,+PARENT,0),U,2)
|
|
. S @FDARR@(.03)=$P(^TIU(8925,+PARENT,0),U,3)
|
|
. S @FDARR@(.05)=$S(+$$REQVER(+$P($G(TIUDPRM(0)),U,3)):4,1:5)
|
|
. S @FDARR@(.06)=PARENT
|
|
. S @FDARR@(.07)=$P($G(TIU("EDT")),U),@FDARR@(.08)=$P($G(TIU("LDT")),U)
|
|
. S @FDARR@(1205)=$P($G(^TIU(8925,+PARENT,12)),U,5)
|
|
. S @FDARR@(1212)=$P($G(^TIU(8925,+PARENT,12)),U,12) ; if parent's div null so is addendum's div
|
|
. S @FDARR@(1401)=$P($G(^TIU(8925,+PARENT,14)),U)
|
|
. S @FDARR@(1402)=$P($G(^TIU(8925,+PARENT,14)),U,2)
|
|
. S @FDARR@(1404)=$P($G(^TIU(8925,+PARENT,14)),U,4)
|
|
. S @FDARR@(1405)=$P($G(^TIU(8925,+PARENT,14)),U,5)
|
|
S @FDARR@(1201)=$$NOW^XLFDT
|
|
I +$G(TIU("LDT")) S TIURDT=+$G(TIU("LDT"))
|
|
I +$G(TIU("LDT"))'>0 D
|
|
. S TIUDICDT=+$$IDATE^TIULC($G(TIUDICDT))
|
|
. I +TIUDICDT,($P(TIUDICDT,".",2)'>0) D
|
|
. . S TIUDICDT=$S($P(TIU("VSTR"),";",3)'="H":$P($G(TIU("EDT")),U),1:"")
|
|
. S TIURDT=$S(+$G(TIUDICDT)>0:+$G(TIUDICDT),1:+$$NOW^TIULC)
|
|
. S:+$G(TIUTYPE)=1 @FDARR@(.12)=1
|
|
. K TIUDICDT
|
|
S @FDARR@(1301)=TIURDT,@FDARR@(1303)="U"
|
|
D FILE^DIE(FLAGS,"FDA","TIUMSG")
|
|
Q
|
|
REQVER(VPARM) ; Evaluate whether verification is required
|
|
Q $S(VPARM=1:1,VPARM=2:1,1:0)
|
|
MAKEADD(TIUDADD,TIUDA,TIUBUF) ; Create an addendum record
|
|
N DIE,DR,DA,DIC,X,Y,DLAYGO,TIUATYP,TIUCAN,TIUFPRIV,TIU,TIUX S TIUFPRIV=1
|
|
N TIUDTTL,TIUPOST,TIUREC
|
|
S TIUDTTL=+$G(^TIU(8925,+TIUDA,0))
|
|
S TIUATYP=+$$WHATITLE^TIUPUTU("ADDENDUM")
|
|
S (DIC,DLAYGO)=8925,DIC(0)="L",X=""""_"`"_TIUATYP_""""
|
|
D ^DIC
|
|
S TIUDADD=+Y
|
|
I +Y'>0 S TIUDADD=TIUDADD_"^Could not create addendum." Q
|
|
D GETTIU^TIULD(.TIU,TIUDA)
|
|
S TIU("DOCTYP")=TIUATYP_U_$$PNAME^TIULC1(TIUATYP)
|
|
D STUFREC(TIUDADD,DFN,+TIUDA,.TIU)
|
|
D LOADTIUX(.TIUX,TIUBUF)
|
|
K ^TIU(8925,+TIUDADD,"TEMP"),TIUX(.001),TIUX(1405)
|
|
M ^TIU(8925,+TIUDADD,"TEMP")=TIUX("TEXT") K TIUX("TEXT")
|
|
D FILE(.SUCCESS,+TIUDADD,.TIUX,TIUATYP)
|
|
D MERGTEXT^TIUEDI1(+TIUDADD,.TIU)
|
|
S TIUPOST=$$POSTFILE^TIULC1(TIUDTTL)
|
|
S TIUREC("#")=TIUDADD
|
|
I TIUPOST]"" X TIUPOST
|
|
K ^TIU(8925,+TIUDADD,"TEMP")
|
|
Q
|
|
FILE(SUCCESS,TIUDA,TIUX,RTYPE) ; Call FM Filer to commit updates to DB
|
|
N FDA,FDARR,IENS,FLAGS,TIUMSG
|
|
S IENS=""""_TIUDA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS="KE"
|
|
M @FDARR=TIUX
|
|
D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record
|
|
I $D(TIUMSG)>9 D
|
|
. S SUCCESS=0_U_$G(TIUMSG("DIERR",1,"TEXT",1))
|
|
. D MAIN^TIUPEVNT(TIUBUF,2,"",$P($G(^TIU(8925.1,+RTYPE,0)),U),.FDA,.TIUMSG)
|
|
E S SUCCESS=TIUDA
|
|
Q
|
|
TRNSFRM(RTYPE,FLD,X) ; Executes Transform code for a given header field
|
|
N XFORM
|
|
S FLD=$O(^TIU(8925.1,+RTYPE,"HEAD","D",+FLD,0))
|
|
I +FLD'>0 G TRNSFRMX
|
|
S XFORM=$G(^TIU(8925.1,+RTYPE,"HEAD",+FLD,1))
|
|
I XFORM']"" G TRNSFRMX
|
|
X XFORM
|
|
TRNSFRMX Q X
|