SROESAR ;BIR/ADM - ANESTHESIA REPORT E-SIG UTILITY ; [ 02/20/02 6:57 AM ]
;;3.0; Surgery ;**100**;24 Jun 93
;
;** NOTICE: This routine is part of an implementation of a nationally
;** controlled procedure. Local modifications to this routine
;** are prohibited.
;
Q
IN N SRS S SRS=1 D GET
Q
EX N SRS S SRS=2 D GET,COMP
I $D(^TMP("SRARAD1",$J,SRTN))!$D(^TMP("SRARAD2",$J,SRTN)) D ^SROESAR2
Q
GET K ^TMP("SRARAD"_SRS,$J,SRTN) D VIEW^SROESAR0,MULT
Q
MULT ; get data from multiples
N SRK F SRK=130.16,130.06,130.33,130.04,130.41 D MULT^SROESAR1
Q
COMP ; compare before and after view
N SRFLD,SRCHNG,SRE,SRE1,SRE2,SRS,SRS1,SROTH,SRLN,SRMULT,X
S SRFLD="" F S SRFLD=$O(^TMP("SRARAD1",$J,SRTN,130,SRFLD)) Q:SRFLD="" S SRCHNG=0 D
.I $P(SRFLD,"-",2)[";W" D Q
..F SRS=1,2 Q:SRCHNG S SRLN=0,SROTH=$S(SRS=1:2,1:1) F S SRLN=$O(^TMP("SRARAD"_SRS,$J,SRTN,130,SRFLD,SRLN)) Q:'SRLN D Q:SRCHNG
...I ^TMP("SRARAD"_SRS,$J,SRTN,130,SRFLD,SRLN)'=$G(^TMP("SRARAD"_SROTH,$J,SRTN,130,SRFLD,SRLN)) S SRCHNG=1
..I 'SRCHNG F SRS=1,2 K ^TMP("SRARAD"_SRS,$J,SRTN,130,SRFLD)
.I ^TMP("SRARAD1",$J,SRTN,130,SRFLD)'=$G(^TMP("SRARAD2",$J,SRTN,130,SRFLD)) S SRCHNG=1
.I 'SRCHNG F SRS=1,2 K ^TMP("SRARAD"_SRS,$J,SRTN,130,SRFLD)
CMULT ; process multiples
F SRS=1,2 K ^TMP("SRARMULT"_SRS,$J,SRTN)
F SRS=1,2 S SRMULT="A" F S SRMULT=$O(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT)) Q:SRMULT="" S SROTH=$S(SRS=1:2,1:1) D PASS1
F SRS=1,2 S SRMULT="A" F S SRMULT=$O(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT)) Q:SRMULT="" S SROTH=$S(SRS=1:2,1:1) D PASS2
F SRS=1,2 S SRMULT="A" F S SRMULT=$O(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT)) Q:SRMULT="" S SROTH=$S(SRS=1:2,1:1) D PASS3
F SRS=1,2 S SRMULT="A" F S SRMULT=$O(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT)) Q:SRMULT="" S SROTH=$S(SRS=1:2,1:1) D PASS4
Q
PASS1 ; delete nodes for unchanged fields except for .01 fields
S SRE=0 F S SRE=$O(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE)) Q:'SRE S SRE1="" F S SRE1=$O(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE,SRE1)) Q:SRE1="" D
.S SRFLD="" F S SRFLD=$O(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)) Q:SRFLD="" S SRCHNG=0 D
..S Y=$P(SRFLD,"-",3) I $P(Y,",",2)=.01 Q
..I $P(SRFLD,"-",3)[";W" D Q
...F SRS1=1,2 Q:SRCHNG S SRLN=0,SROTH=$S(SRS1=1:2,1:1) F S SRLN=$O(^TMP("SRARAD"_SRS1,$J,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN)) Q:'SRLN D
....I ^TMP("SRARAD"_SRS1,$J,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN)'=$G(^TMP("SRARAD"_SROTH,$J,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN)) S SRCHNG=1
...I 'SRCHNG F SRS1=1,2 K ^TMP("SRARAD"_SRS1,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)
..S SROTH=$S(SRS=1:2,1:1) I ^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)'=$G(^TMP("SRARAD"_SROTH,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)) S SRCHNG=1
..I 'SRCHNG F SRS1=1,2 K ^TMP("SRARAD"_SRS1,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)
Q
PASS2 ; delete .01 nodes of sub-multiples if no changes underneath - before or after
N SRNXT1,SRNXT2,SRY1,SRY2
S SRE=0 F S SRE=$O(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE)) Q:'SRE S SRE1=0 F S SRE1=$O(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE,SRE1)) Q:SRE1="" D
.S SRFLD="" F S SRFLD=$O(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)) Q:SRFLD="" D
..I ^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)'=$G(^TMP("SRARAD"_SROTH,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)) Q
..S SRNXT1=$O(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE,SRE1,SRFLD))
..S SRNXT2=$O(^TMP("SRARAD"_SROTH,$J,SRTN,SRMULT,SRE,SRE1,SRFLD))
..I SRNXT1="",SRNXT2="" K ^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE,SRE1,SRFLD),^TMP("SRARAD"_SROTH,$J,SRTN,SRMULT,SRE,SRE1,SRFLD) Q
..S SRY1=$P(SRNXT1,"-",3),SRY2=$P(SRNXT2,"-",3) I $P(SRY1,",",2)=.01,$P(SRY2,",",2)=.01 K ^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE,SRE1,SRFLD),^TMP("SRARAD"_SROTH,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)
Q
PASS3 ; delete .01 nodes for top level multiples if no changes underneath
S SRE=0 F S SRE=$O(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE)) Q:'SRE S SRFLD="" F S SRFLD=$O(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE,0,SRFLD)) Q:SRFLD="" D
.S Y=$P(SRFLD,"-",3) I $P(Y,",",2)'=.01 Q
.I ^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE,0,SRFLD)'=$G(^TMP("SRARAD"_SROTH,$J,SRTN,SRMULT,SRE,0,SRFLD)) Q
.I $O(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE,0,SRFLD))="",$O(^TMP("SRARAD"_SROTH,$J,SRTN,SRMULT,SRE,0,SRFLD))="" D
..I $O(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE,0))'="",$O(^TMP("SRARAD"_SROTH,$J,SRTN,SRMULT,SRE,0))'="" Q
..K ^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE,0,SRFLD),^TMP("SRARAD"_SROTH,$J,SRTN,SRMULT,SRE,0,SRFLD)
Q
PASS4 ; set up list of changed fields for display in addendum
S SRE="" F S SRE=$O(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE)) Q:'SRE S SRE1="" F S SRE1=$O(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE,SRE1)) Q:SRE1="" S SRFLD="" F S SRFLD=$O(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)) Q:SRFLD="" D
.I $P(SRFLD,"-",3)[";W" D Q
..S SRLN=0 F S SRLN=$O(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN)) Q:'SRLN D
...S ^TMP("SRARMULT"_SRS,$J,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN)=$G(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN))
...S ^TMP("SRARMULT"_SROTH,$J,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN)=$G(^TMP("SRARAD"_SROTH,$J,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN))
.S ^TMP("SRARMULT"_SRS,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)=$G(^TMP("SRARAD"_SRS,$J,SRTN,SRMULT,SRE,SRE1,SRFLD))
.S ^TMP("SRARMULT"_SROTH,$J,SRTN,SRMULT,SRE,SRE1,SRFLD)=$G(^TMP("SRARAD"_SROTH,$J,SRTN,SRMULT,SRE,SRE1,SRFLD))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROESAR 5315 printed Oct 16, 2024@18:44:04 Page 2
SROESAR ;BIR/ADM - ANESTHESIA REPORT E-SIG UTILITY ; [ 02/20/02 6:57 AM ]
+1 ;;3.0; Surgery ;**100**;24 Jun 93
+2 ;
+3 ;** NOTICE: This routine is part of an implementation of a nationally
+4 ;** controlled procedure. Local modifications to this routine
+5 ;** are prohibited.
+6 ;
+7 QUIT
IN NEW SRS
SET SRS=1
DO GET
+1 QUIT
EX NEW SRS
SET SRS=2
DO GET
DO COMP
+1 IF $DATA(^TMP("SRARAD1",$JOB,SRTN))!$DATA(^TMP("SRARAD2",$JOB,SRTN))
DO ^SROESAR2
+2 QUIT
GET KILL ^TMP("SRARAD"_SRS,$JOB,SRTN)
DO VIEW^SROESAR0
DO MULT
+1 QUIT
MULT ; get data from multiples
+1 NEW SRK
FOR SRK=130.16,130.06,130.33,130.04,130.41
DO MULT^SROESAR1
+2 QUIT
COMP ; compare before and after view
+1 NEW SRFLD,SRCHNG,SRE,SRE1,SRE2,SRS,SRS1,SROTH,SRLN,SRMULT,X
+2 SET SRFLD=""
FOR
SET SRFLD=$ORDER(^TMP("SRARAD1",$JOB,SRTN,130,SRFLD))
if SRFLD=""
QUIT
SET SRCHNG=0
Begin DoDot:1
+3 IF $PIECE(SRFLD,"-",2)[";W"
Begin DoDot:2
+4 FOR SRS=1,2
if SRCHNG
QUIT
SET SRLN=0
SET SROTH=$SELECT(SRS=1:2,1:1)
FOR
SET SRLN=$ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,130,SRFLD,SRLN))
if 'SRLN
QUIT
Begin DoDot:3
+5 IF ^TMP("SRARAD"_SRS,$JOB,SRTN,130,SRFLD,SRLN)'=$GET(^TMP("SRARAD"_SROTH,$JOB,SRTN,130,SRFLD,SRLN))
SET SRCHNG=1
End DoDot:3
if SRCHNG
QUIT
+6 IF 'SRCHNG
FOR SRS=1,2
KILL ^TMP("SRARAD"_SRS,$JOB,SRTN,130,SRFLD)
End DoDot:2
QUIT
+7 IF ^TMP("SRARAD1",$JOB,SRTN,130,SRFLD)'=$GET(^TMP("SRARAD2",$JOB,SRTN,130,SRFLD))
SET SRCHNG=1
+8 IF 'SRCHNG
FOR SRS=1,2
KILL ^TMP("SRARAD"_SRS,$JOB,SRTN,130,SRFLD)
End DoDot:1
CMULT ; process multiples
+1 FOR SRS=1,2
KILL ^TMP("SRARMULT"_SRS,$JOB,SRTN)
+2 FOR SRS=1,2
SET SRMULT="A"
FOR
SET SRMULT=$ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT))
if SRMULT=""
QUIT
SET SROTH=$SELECT(SRS=1:2,1:1)
DO PASS1
+3 FOR SRS=1,2
SET SRMULT="A"
FOR
SET SRMULT=$ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT))
if SRMULT=""
QUIT
SET SROTH=$SELECT(SRS=1:2,1:1)
DO PASS2
+4 FOR SRS=1,2
SET SRMULT="A"
FOR
SET SRMULT=$ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT))
if SRMULT=""
QUIT
SET SROTH=$SELECT(SRS=1:2,1:1)
DO PASS3
+5 FOR SRS=1,2
SET SRMULT="A"
FOR
SET SRMULT=$ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT))
if SRMULT=""
QUIT
SET SROTH=$SELECT(SRS=1:2,1:1)
DO PASS4
+6 QUIT
PASS1 ; delete nodes for unchanged fields except for .01 fields
+1 SET SRE=0
FOR
SET SRE=$ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE))
if 'SRE
QUIT
SET SRE1=""
FOR
SET SRE1=$ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1))
if SRE1=""
QUIT
Begin DoDot:1
+2 SET SRFLD=""
FOR
SET SRFLD=$ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD))
if SRFLD=""
QUIT
SET SRCHNG=0
Begin DoDot:2
+3 SET Y=$PIECE(SRFLD,"-",3)
IF $PIECE(Y,",",2)=.01
QUIT
+4 IF $PIECE(SRFLD,"-",3)[";W"
Begin DoDot:3
+5 FOR SRS1=1,2
if SRCHNG
QUIT
SET SRLN=0
SET SROTH=$SELECT(SRS1=1:2,1:1)
FOR
SET SRLN=$ORDER(^TMP("SRARAD"_SRS1,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN))
if 'SRLN
QUIT
Begin DoDot:4
+6 IF ^TMP("SRARAD"_SRS1,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN)'=$GET(^TMP("SRARAD"_SROTH,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN))
SET SRCHNG=1
End DoDot:4
+7 IF 'SRCHNG
FOR SRS1=1,2
KILL ^TMP("SRARAD"_SRS1,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD)
End DoDot:3
QUIT
+8 SET SROTH=$SELECT(SRS=1:2,1:1)
IF ^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD)'=$GET(^TMP("SRARAD"_SROTH,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD))
SET SRCHNG=1
+9 IF 'SRCHNG
FOR SRS1=1,2
KILL ^TMP("SRARAD"_SRS1,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD)
End DoDot:2
End DoDot:1
+10 QUIT
PASS2 ; delete .01 nodes of sub-multiples if no changes underneath - before or after
+1 NEW SRNXT1,SRNXT2,SRY1,SRY2
+2 SET SRE=0
FOR
SET SRE=$ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE))
if 'SRE
QUIT
SET SRE1=0
FOR
SET SRE1=$ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1))
if SRE1=""
QUIT
Begin DoDot:1
+3 SET SRFLD=""
FOR
SET SRFLD=$ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD))
if SRFLD=""
QUIT
Begin DoDot:2
+4 IF ^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD)'=$GET(^TMP("SRARAD"_SROTH,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD))
QUIT
+5 SET SRNXT1=$ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD))
+6 SET SRNXT2=$ORDER(^TMP("SRARAD"_SROTH,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD))
+7 IF SRNXT1=""
IF SRNXT2=""
KILL ^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD),^TMP("SRARAD"_SROTH,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD)
QUIT
+8 SET SRY1=$PIECE(SRNXT1,"-",3)
SET SRY2=$PIECE(SRNXT2,"-",3)
IF $PIECE(SRY1,",",2)=.01
IF $PIECE(SRY2,",",2)=.01
KILL ^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD),^TMP("SRARAD"_SROTH,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD)
End DoDot:2
End DoDot:1
+9 QUIT
PASS3 ; delete .01 nodes for top level multiples if no changes underneath
+1 SET SRE=0
FOR
SET SRE=$ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE))
if 'SRE
QUIT
SET SRFLD=""
FOR
SET SRFLD=$ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE,0,SRFLD))
if SRFLD=""
QUIT
Begin DoDot:1
+2 SET Y=$PIECE(SRFLD,"-",3)
IF $PIECE(Y,",",2)'=.01
QUIT
+3 IF ^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE,0,SRFLD)'=$GET(^TMP("SRARAD"_SROTH,$JOB,SRTN,SRMULT,SRE,0,SRFLD))
QUIT
+4 IF $ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE,0,SRFLD))=""
IF $ORDER(^TMP("SRARAD"_SROTH,$JOB,SRTN,SRMULT,SRE,0,SRFLD))=""
Begin DoDot:2
+5 IF $ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE,0))'=""
IF $ORDER(^TMP("SRARAD"_SROTH,$JOB,SRTN,SRMULT,SRE,0))'=""
QUIT
+6 KILL ^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE,0,SRFLD),^TMP("SRARAD"_SROTH,$JOB,SRTN,SRMULT,SRE,0,SRFLD)
End DoDot:2
End DoDot:1
+7 QUIT
PASS4 ; set up list of changed fields for display in addendum
+1 SET SRE=""
FOR
SET SRE=$ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE))
if 'SRE
QUIT
SET SRE1=""
FOR
SET SRE1=$ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1))
if SRE1=""
QUIT
SET SRFLD=""
FOR
SET SRFLD=$ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD))
if SRFLD=""
QUIT
Begin DoDot:1
+2 IF $PIECE(SRFLD,"-",3)[";W"
Begin DoDot:2
+3 SET SRLN=0
FOR
SET SRLN=$ORDER(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN))
if 'SRLN
QUIT
Begin DoDot:3
+4 SET ^TMP("SRARMULT"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN)=$GET(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN))
+5 SET ^TMP("SRARMULT"_SROTH,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN)=$GET(^TMP("SRARAD"_SROTH,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD,SRLN))
End DoDot:3
End DoDot:2
QUIT
+6 SET ^TMP("SRARMULT"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD)=$GET(^TMP("SRARAD"_SRS,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD))
+7 SET ^TMP("SRARMULT"_SROTH,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD)=$GET(^TMP("SRARAD"_SROTH,$JOB,SRTN,SRMULT,SRE,SRE1,SRFLD))
End DoDot:1
+8 QUIT
