SROESL ;BIR/SJA - SURGERY E-SIG UTILITY ; [ 06/13/02 01:30 PM ]
;;3.0; Surgery ;**100**;24 Jun 93
;
; Reference to EXTRACT^TIULQ supported by DBIA #2693
;
CASLIST(SDFN,SIDN) ;
N II,SDT,SRTN,STIU,STIUP,SRY K ^TMP("SROLST",$J)
; SIDN: 1-OPERATION REPORT,
; 2-NURSE INTRAOPERATIVE REPORT,
; 3-PROCEDURE REPORT (NON-O.R.).
; 4-ANESTHESIA REPORT, and
; 5-The above item 1,2, and 4
;
I SIDN<1!(SIDN>5) Q
I SIDN=5 S SIDN="1,2,4"
S SDT=0 F S SDT=$O(^SRF("ADT",SDFN,SDT)) Q:'SDT S SRTN=0 F S SRTN=$O(^SRF("ADT",SDFN,SDT,SRTN)) Q:'SRTN S STIU=$G(^SRF(SRTN,"TIU")) F II=1:1:$L(SIDN,",") S STIUP=$P(STIU,"^",$P(SIDN,",",II)) I STIUP>0 D
.D EXTRACT^TIULQ(STIUP,"SRY",.SRERR,".05") I +$G(SRY(STIUP,.05,"I"))<6 Q
.S ^TMP("SROLST",$J,SRTN,$P(SIDN,",",II))=SRY(STIUP,.05,"E")_"^"_STIUP
.K SRY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROESL 845 printed Dec 13, 2024@02:43:30 Page 2
SROESL ;BIR/SJA - SURGERY E-SIG UTILITY ; [ 06/13/02 01:30 PM ]
+1 ;;3.0; Surgery ;**100**;24 Jun 93
+2 ;
+3 ; Reference to EXTRACT^TIULQ supported by DBIA #2693
+4 ;
CASLIST(SDFN,SIDN) ;
+1 NEW II,SDT,SRTN,STIU,STIUP,SRY
KILL ^TMP("SROLST",$JOB)
+2 ; SIDN: 1-OPERATION REPORT,
+3 ; 2-NURSE INTRAOPERATIVE REPORT,
+4 ; 3-PROCEDURE REPORT (NON-O.R.).
+5 ; 4-ANESTHESIA REPORT, and
+6 ; 5-The above item 1,2, and 4
+7 ;
+8 IF SIDN<1!(SIDN>5)
QUIT
+9 IF SIDN=5
SET SIDN="1,2,4"
+10 SET SDT=0
FOR
SET SDT=$ORDER(^SRF("ADT",SDFN,SDT))
if 'SDT
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("ADT",SDFN,SDT,SRTN))
if 'SRTN
QUIT
SET STIU=$GET(^SRF(SRTN,"TIU"))
FOR II=1:1:$LENGTH(SIDN,",")
SET STIUP=$PIECE(STIU,"^",$PIECE(SIDN,",",II))
IF STIUP>0
Begin DoDot:1
+11 DO EXTRACT^TIULQ(STIUP,"SRY",.SRERR,".05")
IF +$GET(SRY(STIUP,.05,"I"))<6
QUIT
+12 SET ^TMP("SROLST",$JOB,SRTN,$PIECE(SIDN,",",II))=SRY(STIUP,.05,"E")_"^"_STIUP
+13 KILL SRY
End DoDot:1
+14 QUIT
