Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SROESTV

SROESTV.m

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