- 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 Mar 13, 2025@21:48:42 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
