SROESTV ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 03/02/04 8:03 AM ]
;;3.0; Surgery ;**100**;24 Jun 93
;
;** NOTICE: This routine is part of an implementation of a nationally
;** controlled procedure. Local modifications to this routine
;** are prohibited.
;
; Reference to GETDOCS^TIUSRVLR supported by DBIA #3536
;
Q
LIST(SRG,SRDFN,SRSDT,SREDT,SRMAX,SRLDOC) ; return list of completed cases between start and end dates in reverse chronological order
;
; SRG - return array
; SRDFN - pointer to patient file (DFN)
; SRSDT - (optional) start date (earlier date)
; SREDT - (optional) end date (later date)
; SRMAX - (optional) maximum number of case to return
; SRLDOC - (optional) flag to list documents (1) or not (0) (default is 1, list documents)
;
N SRCNT,SRDATE,SREXT,SRFLG,SROP,SRPROV,SRSTOP,SRSDATE,SRQ
S:'$L($G(SRG)) SRG="^TMP(""SRLIST"",$J)" K @SRG
S:'$L($G(SRSDT)) SRSDT=0 S:'$L($G(SREDT)) SREDT=DT S:'$L($G(SRMAX)) SRMAX=""
S (SRCNT,SRQ)=0,X=SREDT+.9999,SRDATE=9999999.9999-X,X=SRSDT-.0001,SRSTOP=9999999.9999-X
S:$G(SRLDOC)'=0 SRLDOC=1
F S SRDATE=$O(^SRF("ADT",SRDFN,SRDATE)) Q:'SRDATE!(SRDATE'<SRSTOP)!SRQ D
.S SROP=0 F S SROP=$O(^SRF("ADT",SRDFN,SRDATE,SROP)) Q:'SROP!SRQ D
..I SRMAX,SRCNT'<SRMAX S SRQ=1 Q
..S SRFLG=1 D CASE
Q
ONE(SRG,SROP) ; return documents associated with a single case
;
; SRG - return array
; SROP - case number in file 130
;
N SRCNT,SRMAX,SRFLG
S:'$L($G(SRG)) SRG="SRTIU" K @SRG
S SRCNT=SROP,SRMAX="",SRFLG=0
D CASE,DOCS
Q
CASE ; list case info
N SRDOC,SRNON,SRSOUT,SROPER,SRN2
S (SRNON,SRSOUT)=0,SRN2=$G(^SRF(SROP,.2))
I $P($G(^SRF(SROP,"NON")),"^")="Y" S SRNON=1
I SRNON,$P($G(^SRF(SROP,"NON")),"^",5)="" Q
I 'SRNON,'$P(SRN2,"^",12)!$P($G(^SRF(SROP,37)),"^")&'($P(SRN2,"^",4)&$P($G(^SRF(SROP,"TIU")),"^",4)) Q
S SROPER=$P(^SRF(SROP,"OP"),"^") I SRNON S SROPER=SROPER_" (Non-OR)"
I $P($G(^SRF(SROP,30)),"^") S SROPER="* Aborted * "_SROPER
S X=$G(^SRF(SROP,"TIU")),SRDOC="" F I=1:1:4 S SRDOC(I)=$P(X,"^",I) I SRDOC(I) S SRDOC="+"
S SRSDATE=$P($G(^SRF(SROP,0)),"^",9)
I SRNON S SRPROV=$P(^SRF(SROP,"NON"),"^",6),SREXT=$$EXTERNAL^DILFD(130,123,"",SRPROV)
I 'SRNON S SRPROV=$P($G(^SRF(SROP,.1)),"^",4),SREXT=$$EXTERNAL^DILFD(130,.14,"",SRPROV)
S SRPROV=SRPROV_";"_SREXT S:SRFLG SRCNT=SRCNT+1
S @SRG@(SRCNT)=SROP_"^"_SROPER_"^"_SRSDATE_"^"_SRPROV_"^"_SRDOC
I SRFLG,SRLDOC D DOCS
Q
DOCS ; fetch documents associated with surgical case
N SRLB,SRNUM,SRNUMX,SRTITLE,SRTIUY,SROVP K ^TMP("SRTMP",$J)
S SRTIUY="",SROVP=SROP_";SRF(" D GETDOCS^TIUSRVLR(SRTIUY,SROVP)
S SRNUM=0 F S SRNUM=$O(^TMP("TIULIST",$J,SRNUM)) Q:'SRNUM D
.S SRTITLE=$P(^TMP("TIULIST",$J,SRNUM),"^",2)
.I SRTITLE["OPERATION REPORT"!(SRTITLE["PROCEDURE REPORT") S ^TMP("SRTMP",$J,1,SRNUM)=^TMP("TIULIST",$J,SRNUM) Q
.I SRTITLE["NURSE INTRAOPERATIVE REPORT" S ^TMP("SRTMP",$J,2,SRNUM)=^TMP("TIULIST",$J,SRNUM) Q
.I SRTITLE["ANESTHESIA REPORT" S ^TMP("SRTMP",$J,3,SRNUM)=^TMP("TIULIST",$J,SRNUM)
S SRNUMX=1 F SRLB=1,2,3 S SRNUM=0 F S SRNUM=$O(^TMP("SRTMP",$J,SRLB,SRNUM)) Q:'SRNUM S @SRG@(SRCNT,SRNUMX)=^TMP("SRTMP",$J,SRLB,SRNUM),SRNUMX=SRNUMX+1
K ^TMP("SRTMP",$J)
Q
NON(SROP) ; determine if case is non-OR procedure
; returns 1 if case is non-OR procedure
; returns 0 if case is not non-OR procedure
N SRNON S SRNON=0 I $P($G(^SRF(SROP,"NON")),"^")="Y" S SRNON=1
Q SRNON
OPTOP(SROP) ; return parameter value for showing OpTop on signature
; 0 - never display Op Top
N SROPTOP S SROPTOP=0
Q SROPTOP
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROESTV 3565 printed Oct 16, 2024@18:44:19 Page 2
SROESTV ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 03/02/04 8:03 AM ]
+1 ;;3.0; Surgery ;**100**;24 Jun 93
+2 ;
+3 ;** NOTICE: This routine is part of an implementation of a nationally
+4 ;** controlled procedure. Local modifications to this routine
+5 ;** are prohibited.
+6 ;
+7 ; Reference to GETDOCS^TIUSRVLR supported by DBIA #3536
+8 ;
+9 QUIT
LIST(SRG,SRDFN,SRSDT,SREDT,SRMAX,SRLDOC) ; return list of completed cases between start and end dates in reverse chronological order
+1 ;
+2 ; SRG - return array
+3 ; SRDFN - pointer to patient file (DFN)
+4 ; SRSDT - (optional) start date (earlier date)
+5 ; SREDT - (optional) end date (later date)
+6 ; SRMAX - (optional) maximum number of case to return
+7 ; SRLDOC - (optional) flag to list documents (1) or not (0) (default is 1, list documents)
+8 ;
+9 NEW SRCNT,SRDATE,SREXT,SRFLG,SROP,SRPROV,SRSTOP,SRSDATE,SRQ
+10 if '$LENGTH($GET(SRG))
SET SRG="^TMP(""SRLIST"",$J)"
KILL @SRG
+11 if '$LENGTH($GET(SRSDT))
SET SRSDT=0
if '$LENGTH($GET(SREDT))
SET SREDT=DT
if '$LENGTH($GET(SRMAX))
SET SRMAX=""
+12 SET (SRCNT,SRQ)=0
SET X=SREDT+.9999
SET SRDATE=9999999.9999-X
SET X=SRSDT-.0001
SET SRSTOP=9999999.9999-X
+13 if $GET(SRLDOC)'=0
SET SRLDOC=1
+14 FOR
SET SRDATE=$ORDER(^SRF("ADT",SRDFN,SRDATE))
if 'SRDATE!(SRDATE'<SRSTOP)!SRQ
QUIT
Begin DoDot:1
+15 SET SROP=0
FOR
SET SROP=$ORDER(^SRF("ADT",SRDFN,SRDATE,SROP))
if 'SROP!SRQ
QUIT
Begin DoDot:2
+16 IF SRMAX
IF SRCNT'<SRMAX
SET SRQ=1
QUIT
+17 SET SRFLG=1
DO CASE
End DoDot:2
End DoDot:1
+18 QUIT
ONE(SRG,SROP) ; return documents associated with a single case
+1 ;
+2 ; SRG - return array
+3 ; SROP - case number in file 130
+4 ;
+5 NEW SRCNT,SRMAX,SRFLG
+6 if '$LENGTH($GET(SRG))
SET SRG="SRTIU"
KILL @SRG
+7 SET SRCNT=SROP
SET SRMAX=""
SET SRFLG=0
+8 DO CASE
DO DOCS
+9 QUIT
CASE ; list case info
+1 NEW SRDOC,SRNON,SRSOUT,SROPER,SRN2
+2 SET (SRNON,SRSOUT)=0
SET SRN2=$GET(^SRF(SROP,.2))
+3 IF $PIECE($GET(^SRF(SROP,"NON")),"^")="Y"
SET SRNON=1
+4 IF SRNON
IF $PIECE($GET(^SRF(SROP,"NON")),"^",5)=""
QUIT
+5 IF 'SRNON
IF '$PIECE(SRN2,"^",12)!$PIECE($GET(^SRF(SROP,37)),"^")&'($PIECE(SRN2,"^",4)&$PIECE($GET(^SRF(SROP,"TIU")),"^",4))
QUIT
+6 SET SROPER=$PIECE(^SRF(SROP,"OP"),"^")
IF SRNON
SET SROPER=SROPER_" (Non-OR)"
+7 IF $PIECE($GET(^SRF(SROP,30)),"^")
SET SROPER="* Aborted * "_SROPER
+8 SET X=$GET(^SRF(SROP,"TIU"))
SET SRDOC=""
FOR I=1:1:4
SET SRDOC(I)=$PIECE(X,"^",I)
IF SRDOC(I)
SET SRDOC="+"
+9 SET SRSDATE=$PIECE($GET(^SRF(SROP,0)),"^",9)
+10 IF SRNON
SET SRPROV=$PIECE(^SRF(SROP,"NON"),"^",6)
SET SREXT=$$EXTERNAL^DILFD(130,123,"",SRPROV)
+11 IF 'SRNON
SET SRPROV=$PIECE($GET(^SRF(SROP,.1)),"^",4)
SET SREXT=$$EXTERNAL^DILFD(130,.14,"",SRPROV)
+12 SET SRPROV=SRPROV_";"_SREXT
if SRFLG
SET SRCNT=SRCNT+1
+13 SET @SRG@(SRCNT)=SROP_"^"_SROPER_"^"_SRSDATE_"^"_SRPROV_"^"_SRDOC
+14 IF SRFLG
IF SRLDOC
DO DOCS
+15 QUIT
DOCS ; fetch documents associated with surgical case
+1 NEW SRLB,SRNUM,SRNUMX,SRTITLE,SRTIUY,SROVP
KILL ^TMP("SRTMP",$JOB)
+2 SET SRTIUY=""
SET SROVP=SROP_";SRF("
DO GETDOCS^TIUSRVLR(SRTIUY,SROVP)
+3 SET SRNUM=0
FOR
SET SRNUM=$ORDER(^TMP("TIULIST",$JOB,SRNUM))
if 'SRNUM
QUIT
Begin DoDot:1
+4 SET SRTITLE=$PIECE(^TMP("TIULIST",$JOB,SRNUM),"^",2)
+5 IF SRTITLE["OPERATION REPORT"!(SRTITLE["PROCEDURE REPORT")
SET ^TMP("SRTMP",$JOB,1,SRNUM)=^TMP("TIULIST",$JOB,SRNUM)
QUIT
+6 IF SRTITLE["NURSE INTRAOPERATIVE REPORT"
SET ^TMP("SRTMP",$JOB,2,SRNUM)=^TMP("TIULIST",$JOB,SRNUM)
QUIT
+7 IF SRTITLE["ANESTHESIA REPORT"
SET ^TMP("SRTMP",$JOB,3,SRNUM)=^TMP("TIULIST",$JOB,SRNUM)
End DoDot:1
+8 SET SRNUMX=1
FOR SRLB=1,2,3
SET SRNUM=0
FOR
SET SRNUM=$ORDER(^TMP("SRTMP",$JOB,SRLB,SRNUM))
if 'SRNUM
QUIT
SET @SRG@(SRCNT,SRNUMX)=^TMP("SRTMP",$JOB,SRLB,SRNUM)
SET SRNUMX=SRNUMX+1
+9 KILL ^TMP("SRTMP",$JOB)
+10 QUIT
NON(SROP) ; determine if case is non-OR procedure
+1 ; returns 1 if case is non-OR procedure
+2 ; returns 0 if case is not non-OR procedure
+3 NEW SRNON
SET SRNON=0
IF $PIECE($GET(^SRF(SROP,"NON")),"^")="Y"
SET SRNON=1
+4 QUIT SRNON
OPTOP(SROP) ; return parameter value for showing OpTop on signature
+1 ; 0 - never display Op Top
+2 NEW SROPTOP
SET SROPTOP=0
+3 QUIT SROPTOP
