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