21 lines
825 B
Mathematica
21 lines
825 B
Mathematica
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
|