- 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 Feb 19, 2025@00:10:09 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