SROESL.m

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 ---SROESL   845     printed  Apr 09, 2024@21:43:13                                                                                                                                                                                                       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