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