155 lines
6.3 KiB
Mathematica
155 lines
6.3 KiB
Mathematica
TIUPUTS ; SLC/JER - Surgery Look-up, etc. ; 04/19/2004
|
|
;;1.0;TEXT INTEGRATION UTILITIES;**112,187,173,195,204**;Jun 20, 1997
|
|
LOOKUP ; Look-up code used by router/filer
|
|
; Required: TIUSRCN, TIUSDA, TIUSSN, TIUODT
|
|
N SRODT,DFN,TIUSR0,TIUD0,TIUDAD
|
|
I $S('$D(TIUSSN):1,$G(TIUSSN)?4N:1,$G(TIUSSN)']"":1,+$G(TIUODT)'>0:1,1:0) S Y=-1 G LOOKUPX
|
|
I TIUSSN?3N1P2N1P4N.E S TIUSSN=$TR(TIUSSN,"-/","")
|
|
I TIUSSN["?" S Y=-1 G LOOKUPX
|
|
S DFN=+$$PATIENT^TIULA(TIUSSN)
|
|
I DFN'>0 S Y=-1 G LOOKUPX
|
|
I +$G(TIUSRCN)=0 S TIUSRCN=$$FINDCASE(DFN,+$$IDATE^TIULC(TIUODT))
|
|
I +$G(TIUSRCN)'>0 S Y=-1 G LOOKUPX
|
|
I +$G(TIUSDA)'>0,$D(^SRF(TIUSRCN,"TIU")) S TIUSDA=$$GETSDA(TIUSRCN)
|
|
I +$G(TIUSDA)'>0 D G LOOKUPX
|
|
. S Y=-1
|
|
. I '$D(^SRF(TIUSRCN,"TIU")),'$D(ZTQUEUED) D
|
|
. . W !!,"Time Out of O.R. has not yet been entered for Surgical Case #",TIUSRCN
|
|
. . W !,"the Surgical Service must complete this step before the Operation"
|
|
. . W !,"Report can be uploaded..."
|
|
K TIUHDR(.001),TIUHDR(.02),TIUHDR(.07),TIUHDR(1405)
|
|
S TIUD0=$G(^TIU(8925,TIUSDA,0)),TIUSR0=$G(^SRF(TIUSRCN,0))
|
|
;Confirm that SURGICAL CASE is for correct patient
|
|
I +TIUSR0'=DFN S Y=-1 G LOOKUPX
|
|
;Confirm that TIU DOCUMENT is for correct patient
|
|
I +$P(TIUD0,U,2)'=DFN S Y=-1 G LOOKUPX
|
|
;Confirm that OPERATION DATE is correct
|
|
I +$$IDATE^TIULC(TIUODT)'=$P($P(TIUSR0,U,9),".") S Y=-1 G LOOKUPX
|
|
S Y=$$CALLDIC(TIUSDA)
|
|
I '+$$CANEDIT(+Y) D
|
|
. W !,"Existing document may not be edited...Creating Addendum."
|
|
. S TIUDAD=+Y,Y=$$MAKEADD^TIUPUTU()
|
|
. D COPYDAD(Y,TIUDAD)
|
|
LOOKUPX K TIUSRCN,TIUSDA
|
|
Q
|
|
CANEDIT(DA) ; Check whether or not document is released
|
|
Q $S(+$P($G(^TIU(8925,+DA,0)),U,5)<4:1,1:0)
|
|
COPYDAD(DA,PARENT) ; copy fixed field data for addenda
|
|
N FDA,FDARR,IENS,FLAGS,TIUMSG,TIUOPDT,TIURDT,TIUD0,TIUD12,TIUD14
|
|
S TIUD0=$G(^TIU(8925,+PARENT,0)),TIUD12=$G(^(12)),TIUD14=$G(^(14))
|
|
S IENS=""""_DA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS="K"
|
|
S @FDARR@(.02)=$P(TIUD0,U,2)
|
|
S @FDARR@(.03)=$P(TIUD0,U,3),@FDARR@(.05)=3
|
|
S @FDARR@(.06)=PARENT,@FDARR@(.08)=$P(TIUD0,U,8)
|
|
S @FDARR@(1401)=$P(TIUD14,U)
|
|
S @FDARR@(1402)=$P(TIUD14,U,2)
|
|
S @FDARR@(1405)=TIUSRCN_";SRF("
|
|
S @FDARR@(1201)=$$NOW^TIULC
|
|
S @FDARR@(1205)=$P(TIUD12,U,5)
|
|
S TIUOPDT=+$$IDATE^TIULC($G(TIUODT))
|
|
S TIURDT=$S(+$G(TIUOPDT)>0:+$G(TIUOPDT),1:+$$NOW^XLFDT)
|
|
S @FDARR@(1301)=TIURDT,@FDARR@(1303)="U"
|
|
D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record
|
|
Q
|
|
FINDCASE(DFN,TIUODT) ; Find Surgical Case for Pt & Dt, if unique
|
|
N TIUY,TIUCN,TIUHIT,TIUPOP S TIUCN="",(TIUY,TIUHIT,TIUPOP)=0
|
|
F S TIUCN=$O(^SRF("B",DFN,TIUCN),-1) Q:TIUCN'>0!+TIUPOP D
|
|
. N TIUSR0 S TIUSR0=$G(^SRF(TIUCN,0))
|
|
. I +$G(TIUODT)=$P($P(TIUSR0,U,9),".") D
|
|
. . I +TIUHIT S TIUPOP=1 Q
|
|
. . S TIUHIT=TIUCN
|
|
I 'TIUPOP,TIUHIT S TIUY=TIUHIT
|
|
Q TIUY
|
|
GETSDA(TIUSRCN) ; Get Op Report for Case
|
|
N TIUY S TIUY=+$P(^SRF(TIUSRCN,"TIU"),U)
|
|
I 'TIUY S TIUY=+$P(^SRF(TIUSRCN,"TIU"),U,3)
|
|
Q TIUY
|
|
CALLDIC(TIUX) ; Call ^DIC to get the IEN for the TIU DOCUMENT
|
|
N DA,DIC,X,Y
|
|
S DIC=8925,DIC(0)="NX",X="`"_TIUX D ^DIC
|
|
Q Y
|
|
FOLLOWUP(TIUDA) ; Post-filing code for Operation Reports
|
|
N FDA,FDARR,IENS,FLAGS,TIUMSG,TIU
|
|
S IENS=""""_TIUDA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS="K"
|
|
D GETTIU^TIULD(.TIU,TIUDA)
|
|
I $L($G(TIU("EDT"))) S @FDARR@(.07)=$P($G(TIU("EDT")),U)
|
|
S @FDARR@(1204)=$$WHOSIGNS^TIULC1(TIUDA)
|
|
S @FDARR@(1208)=$$WHOCOSIG^TIULC1(TIUDA)
|
|
D FILE^DIE(FLAGS,"FDA","TIUMSG")
|
|
I +$P($G(^TIU(8925,+TIUDA,12)),U,4)'=+$P($G(^(12)),U,9) D
|
|
. S @FDARR@(1506)=1 D FILE^DIE(FLAGS,"FDA","TIUMSG")
|
|
D RELEASE^TIUT(TIUDA,1)
|
|
D AUDIT^TIUEDI1(TIUDA,0,$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")"))
|
|
Q
|
|
FIX ; Filing error resolution code for Operation Reports
|
|
N TIUOUT,TIUDA,TIUD0,TIUX,TIUPRM0,TIUPRM1,SUCCESS,TIUBUF,TIUHIT
|
|
N TIUADD,TIUTYP,TIU,DUOUT,DTOUT
|
|
S TIUHIT=0
|
|
; -- first, determine the correct TIU DOCUMENT record --
|
|
F D Q:$D(DUOUT)!$D(DIROUT)!+$G(TIUOUT)
|
|
. N D,D0,DK,DL,DIC,X,Y,DA,DX,A,S,TIUFPRIV
|
|
. S X=+$$PATIENT^TIULA
|
|
. I X'>0 D Q
|
|
. . W !!,"Okay, no harm done...",!
|
|
. . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
|
|
. . S TIUOUT=1
|
|
. S DIC=8925,DIC(0)="UXEV",D="C"
|
|
. W !
|
|
. S DIC("W")="D DICW^TIUPUTS(+Y)"
|
|
. S DIC("S")="I +$$DICS^TIUPUTS(+Y)"
|
|
. D IX^DIC
|
|
. I +Y'>0 D Q
|
|
. . W !!,$S(+$O(^TIU(8925,"C",+X,0))'>0:"No OPERATION REPORTS Available to Update.",1:"No OPERATION REPORT Selected..."),!
|
|
. . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
|
|
. . S TIUOUT=1
|
|
. W ! S (DA,TIUHIT)=+Y D EN^DIQ
|
|
. S TIUOUT=$$READ^TIUU("Y","... OK","YES") W !
|
|
. I +TIUOUT S TIUDA=DA
|
|
Q:$D(DUOUT)!$D(DIROUT)!+$G(DTOUT)!'+$G(TIUDA)
|
|
; -- next, load fields from upload buffer entry --
|
|
S TIUBUF=$S(+$G(XQADATA):+$G(XQADATA),+$G(BUFDA):+$G(BUFDA),1:"")
|
|
; -- if TIUDA may be edited, file data, else make addendum --
|
|
S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUTYP=+TIUD0
|
|
I +$$CANEDIT(TIUDA)'>0 D G FIXX
|
|
. W !!,"Existing document may not be edited...Creating Addendum.",!
|
|
. D MAKEADD^TIUPEFIX(.TIUADD,TIUDA,TIUBUF)
|
|
. S SUCCESS=TIUADD
|
|
; -- Load the array TIUX from the buffer
|
|
D LOADTIUX^TIUPEFIX(.TIUX,TIUBUF)
|
|
; -- finally, file data in TIU DOCUMENT file --
|
|
K ^TIU(8925,+TIUDA,"TEMP"),TIUX(.001),TIUX(.01),TIUX(.02),TIUX(.03),TIUX(.05)
|
|
K TIUX(.13),TIUX(1205),TIUX(1211),TIUX(1405)
|
|
M ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT") K TIUX("TEXT")
|
|
D FILE^TIUPEFIX(.SUCCESS,+TIUDA,.TIUX,TIUTYP)
|
|
D GETTIU^TIULD(.TIU,TIUDA)
|
|
D MERGTEXT^TIUEDI1(+TIUDA,.TIU) K ^TIU(8925,TIUDA,"TEMP")
|
|
S TIUPOST=$$POSTFILE^TIULC1(TIUTYP)
|
|
S TIUREC("#")=TIUDA
|
|
I TIUPOST]"" X TIUPOST
|
|
FIXX D ALERTDEL^TIUPEVNT(+TIUBUF)
|
|
D RESOLVE^TIUPEVNT($S($D(XQADATA):+$P(XQADATA,";",3),1:$G(ERRDA)),1)
|
|
D BUFPURGE^TIUPUTC(+TIUBUF)
|
|
W "Done."
|
|
S TIUDONE=1
|
|
Q
|
|
DICW(TIUDA) ; Write identifiers
|
|
;VMP OIFO BAY PINES;ELR;TIU*1.0*195;MODIFIED THIS TAG
|
|
N X,Y,VADM,VA,VAERR,TIUD0,TIUD12,TIUD13,TIUD14,TIUPRNM
|
|
S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^(12)),TIUD13=$G(^(13)),TIUD14=$G(^(14))
|
|
W ?35,"Dated: ",$$DATE^TIULS(+TIUD13,"MM/DD/CCYY@HR:MIN"),?62,"By: ",$E($$NAME^TIULS($$PERSNAME^TIULC1(+$P(TIUD12,U,2)),"LAST,FI MI"),1,13)
|
|
;VMP OIFO BAY PINES;ELR;TIU*1.0*195;ADDED FROM HERE DOWN
|
|
Q:$G(TIUCLASS)'=38
|
|
S TIUD14=+$P(TIUD14,U,5)
|
|
Q:$L(TIUD14)'>0
|
|
D ONE^SROESTV(.TIUPRNM,TIUD14) ;IA 3533
|
|
N TIUS0 S TIUS0=$G(@TIUPRNM@(TIUD14))
|
|
Q:$L(TIUS0)'>0
|
|
W !?11,"Case #: ",TIUD14," ",$P(@TIUPRNM@(TIUD14),U,2)
|
|
Q
|
|
DICS(TIUDA) ; Filter IX^DIC list
|
|
N TIUD0,TIUY S TIUY=0
|
|
S TIUD0=$G(^TIU(8925,TIUDA,0))
|
|
I +$$ISA^TIULX(+TIUD0,+$$CLASS^TIUSROI("OPERATION REPORTS")) S TIUY=1 I 1
|
|
E I +$$ISA^TIULX(+TIUD0,+$$CLASS^TIUSROI("PROCEDURE REPORT (NON-O.R.)")) S TIUY=1
|
|
Q TIUY
|