- SROAUTL0 ;BIR/ADM,SLM - RISK ASSESSMENT UTILITY ;08/16/2011
- ;;3.0;Surgery;**38,47,57,60,61,63,81,125,153,160,174,176,177,182,184**;24 Jun 93;Build 35
- PREOP K DR S SRQ=1,DR="325;238;492;204;203;423;332;333;338;339;215;217"
- Q
- PREMD K DR S SRQ=1,DR=".011;247;413;417;418;419;420;421;452;453;454"
- Q
- OPER K DR S SRQ=0,DR=".03;.04;26;27;214;.42;.035;1.09;1.13;.37;.22;.23;340;66"
- Q
- LR K DR S SRQ=0,DR="225;292;228;295;224;291;234;301;230;297;227;294"
- Q
- OUT1 ; man preop edit scr
- Q
- LAB ; man lab edit scrn
- Q
- CPTS ; put CPT codes in array for display
- N SRDA,K,X,XX,Y K SRPROC S K=1,Y=$P($G(^SRO(136,SRTN,0)),"^",2),Y=$S(Y:$P($$CPT^ICPTCOD(Y),"^",2),1:"")
- I $L(Y) D SSPRIN^SROCPT0
- S SRPROC(K)=$S($L(Y):Y,1:"NO PRIN CODE")
- S SRDA=0 F S SRDA=$O(^SRO(136,SRTN,3,SRDA)) Q:'SRDA D
- .S Y=$P($G(^SRO(136,SRTN,3,SRDA,0)),"^"),Y=$S(Y:$P($$CPT^ICPTCOD(Y),"^",2),1:"")
- .I $L(Y) D SSOTH^SROCPT0
- .I $L(Y)+$L(SRPROC(K))'>SRL S SRPROC(K)=SRPROC(K)_", "_Y Q
- .S K=K+1,SRPROC(K)=Y
- I SRPROC(1)=""!(SRPROC(1)="NO PRIN CODE") S SRPROC(1)="NOT ENTERED"
- Q
- DISP ; display CPT code info
- N SRFIRST,SRMO,SRMOD,SRCSTAT S SRPAGE="",SRCSTAT=">> Coding "_$S($P($G(^SRO(136,SRTN,10)),"^"):"",1:"Not ")_"Complete <<"
- D HDR^SROAUTL S SRFIRST=0,SRW="NOT ENTERED"
- S Y=$P($G(^SRO(136,SRTN,0)),"^",2) I Y S Y=$P($$CPT^ICPTCOD(Y),"^",2) D DES^SROCPT0
- W "Principal CPT Code: "_SRW I $G(SRDES(1))'="" F I=1:1 Q:$L(SRDES(I))'>1 W !,?5,SRDES(I)
- I $O(^SRO(136,SRTN,1,0)) W !,?3,"Modifier: " D
- .S SRMOD=0 F S SRMOD=$O(^SRO(136,SRTN,1,SRMOD)) Q:'SRMOD D
- ..S SRMO=$P(^SRO(136,SRTN,1,SRMOD,0),"^")
- ..W:SRFIRST !,?13 W $P($$MOD^ICPTMOD(SRMO,"I"),"^",2),"-",$P($$MOD^ICPTMOD(SRMO,"I"),"^",3)
- ..S SRFIRST=1
- K SRDES W !
- OTH S SROTH=0 F S SROTH=$O(^SRO(136,SRTN,3,SROTH)) Q:'SROTH D K SRDES W !
- .S Y=$P($G(^SRO(136,SRTN,3,SROTH,0)),"^"),Y=$S(Y:$P($$CPT^ICPTCOD(Y),"^",2),1:"") D DES^SROCPT0
- .W !,"Other CPT Code: "_SRW I $G(SRDES(1))'="" F I=1:1 Q:$L(SRDES(I))'>1 W !,?5,SRDES(I)
- .I $O(^SRO(136,SRTN,3,SROTH,1,0)) S SRFIRST=0 W !,?3,"Modifier: " D
- ..S SRMOD=0 F S SRMOD=$O(^SRO(136,SRTN,3,SROTH,1,SRMOD)) Q:'SRMOD D
- ...S SRMO=$P(^SRO(136,SRTN,3,SROTH,1,SRMOD,0),"^")
- ...W:SRFIRST !,?13 W $P($$MOD^ICPTMOD(SRMO,"I"),"^",2),"-",$P($$MOD^ICPTMOD(SRMO,"I"),"^",3)
- ...S SRFIRST=1
- PRESS K DIR S DIR(0)="FOA",DIR("A")="Press ENTER to continue."
- S DIR("A",1)="CPT Codes should be verified. If need be, report discrepancies to the"
- S DIR("A",2)="official CPT coder for surgery.",DIR("A",3)="" D ^DIR K DIR
- Q
- OCC ; occur data
- N SR40 S SR40=" " K SRSEP,SRDUR
- D EN^SROCCAT K ^TMP("SROCC",$J),SRO,SROC,SROOC
- F SRK=1:1:42 S SROC(SRK)=" "
- S (SRFLG,SRIO,SRPO)=0 F S SRIO=$O(^SRF(SRTN,10,SRIO)) Q:'SRIO D
- .S SROCC=$P(^SRF(SRTN,10,SRIO,0),U,2) Q:'SROCC
- .S ^TMP("SROCC",$J,SROCC,$E($P(^SRF(SRTN,0),U,9),1,7),10)=SRIO
- F S SRPO=$O(^SRF(SRTN,16,SRPO)) Q:'SRPO D
- .S SRDATE=$E($P(^SRF(SRTN,16,SRPO,0),U,7),1,7)
- .S X1=$E(SRSDATE,1,7),X2=30 D C^%DTC
- .I SRDATE>X Q
- .I '$G(SRDATE) S SRDATE=" "
- .S SROCC=$P(^SRF(SRTN,16,SRPO,0),U,2) Q:'SROCC
- .S ^TMP("SROCC",$J,SROCC,SRDATE,16)=SRPO
- I '$D(^TMP("SROCC",$J)) D OCCEND Q
- ;remove multiples
- S SROCC=0 F S SROCC=$O(^TMP("SROCC",$J,SROCC)) Q:'SROCC S SROCCDT=$O(^TMP("SROCC",$J,SROCC,0)),SRTYPE=$O(^TMP("SROCC",$J,SROCC,SROCCDT,0)) D
- .I SROCC=21!(SROCC>28&(SROCC<33))!(SROCC=36) D
- ..S SRDA=^TMP("SROCC",$J,SROCC,SROCCDT,SRTYPE),SRICD=$P(^SRF(SRTN,SRTYPE,SRDA,0),U,3)
- ..I SRICD S SROOC(SROCC)=$P($$ICD^SROICD(SRTN,SRICD),"^",2)_"^"_$P(^SRF(SRTN,SRTYPE,SRDA,0),U)
- ..E S SROOC(SROCC)="NO ICD CODE ENTERED"
- .S ^TMP("SROCC",$J,"SR",SROCC,SROCCDT)=""
- S SRK=1,SRO="",SROCC=0 F S SROCC=$O(^TMP("SROCC",$J,"SR",SROCC)) Q:'SROCC S SROCCDT="" F S SROCCDT=$O(^TMP("SROCC",$J,"SR",SROCC,SROCCDT)) Q:SROCCDT="" D
- .I SROCC=3 S SRPO=^TMP("SROCC",$J,SROCC,SROCCDT,16) I SRPO S X=$P(^SRF(SRTN,16,SRPO,0),"^",4) S:X SRSEP=X
- .I SROCC=12 S SRPO=^TMP("SROCC",$J,SROCC,SROCCDT,16) I SRPO S X=$P(^SRF(SRTN,16,SRPO,0),"^",8) S:X SRDUR=X
- .I SROCC=40 S SRPO=^TMP("SROCC",$J,SROCC,SROCCDT,16) I SRPO S X=$P(^SRF(SRTN,16,SRPO,0),"^",9,13) D
- ..S SR40="" F I=1:1:5 S SR40=SR40_$J($P(X,"^",I),1)
- .S SROC(SROCC)=SROCCDT
- F I=1:1:22,29:1:32,35,36,38 S SRO=SRO_$J(SROC(I),7)
- S X=$G(SRSEP),SRO=SRO_$J(X,1) I X S SRSEP=$S(X=2:"SEPSIS",X=3:"SEPTIC SHOCK",1:"SIRS")
- S X=$G(SRDUR),SRO=SRO_$J(X,1) I X S SRDUR=$S(X=2:"<24 HOURS",X=3:"24-72 HOURS",X=4:">72 HOURS",1:"NO SYMPTOMS")
- S SRO=SRO_$J(SROC(40),7)_$J(SROC(41),7)_SR40_$J(SROC(42),7)
- OCCEND K ^TMP("SROCC",$J),SRPOCC,SRPOCCD,SRSDATE,SRTYPE,SRDATE,SRDA,SRFLG,SRICD,SRJ,SRK,SROCC,SROCCDT,SRPO,X1,X2
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROAUTL0 4657 printed Jan 18, 2025@03:43:30 Page 2
- SROAUTL0 ;BIR/ADM,SLM - RISK ASSESSMENT UTILITY ;08/16/2011
- +1 ;;3.0;Surgery;**38,47,57,60,61,63,81,125,153,160,174,176,177,182,184**;24 Jun 93;Build 35
- PREOP KILL DR
- SET SRQ=1
- SET DR="325;238;492;204;203;423;332;333;338;339;215;217"
- +1 QUIT
- PREMD KILL DR
- SET SRQ=1
- SET DR=".011;247;413;417;418;419;420;421;452;453;454"
- +1 QUIT
- OPER KILL DR
- SET SRQ=0
- SET DR=".03;.04;26;27;214;.42;.035;1.09;1.13;.37;.22;.23;340;66"
- +1 QUIT
- LR KILL DR
- SET SRQ=0
- SET DR="225;292;228;295;224;291;234;301;230;297;227;294"
- +1 QUIT
- OUT1 ; man preop edit scr
- +1 QUIT
- LAB ; man lab edit scrn
- +1 QUIT
- CPTS ; put CPT codes in array for display
- +1 NEW SRDA,K,X,XX,Y
- KILL SRPROC
- SET K=1
- SET Y=$PIECE($GET(^SRO(136,SRTN,0)),"^",2)
- SET Y=$SELECT(Y:$PIECE($$CPT^ICPTCOD(Y),"^",2),1:"")
- +2 IF $LENGTH(Y)
- DO SSPRIN^SROCPT0
- +3 SET SRPROC(K)=$SELECT($LENGTH(Y):Y,1:"NO PRIN CODE")
- +4 SET SRDA=0
- FOR
- SET SRDA=$ORDER(^SRO(136,SRTN,3,SRDA))
- if 'SRDA
- QUIT
- Begin DoDot:1
- +5 SET Y=$PIECE($GET(^SRO(136,SRTN,3,SRDA,0)),"^")
- SET Y=$SELECT(Y:$PIECE($$CPT^ICPTCOD(Y),"^",2),1:"")
- +6 IF $LENGTH(Y)
- DO SSOTH^SROCPT0
- +7 IF $LENGTH(Y)+$LENGTH(SRPROC(K))'>SRL
- SET SRPROC(K)=SRPROC(K)_", "_Y
- QUIT
- +8 SET K=K+1
- SET SRPROC(K)=Y
- End DoDot:1
- +9 IF SRPROC(1)=""!(SRPROC(1)="NO PRIN CODE")
- SET SRPROC(1)="NOT ENTERED"
- +10 QUIT
- DISP ; display CPT code info
- +1 NEW SRFIRST,SRMO,SRMOD,SRCSTAT
- SET SRPAGE=""
- SET SRCSTAT=">> Coding "_$SELECT($PIECE($GET(^SRO(136,SRTN,10)),"^"):"",1:"Not ")_"Complete <<"
- +2 DO HDR^SROAUTL
- SET SRFIRST=0
- SET SRW="NOT ENTERED"
- +3 SET Y=$PIECE($GET(^SRO(136,SRTN,0)),"^",2)
- IF Y
- SET Y=$PIECE($$CPT^ICPTCOD(Y),"^",2)
- DO DES^SROCPT0
- +4 WRITE "Principal CPT Code: "_SRW
- IF $GET(SRDES(1))'=""
- FOR I=1:1
- if $LENGTH(SRDES(I))'>1
- QUIT
- WRITE !,?5,SRDES(I)
- +5 IF $ORDER(^SRO(136,SRTN,1,0))
- WRITE !,?3,"Modifier: "
- Begin DoDot:1
- +6 SET SRMOD=0
- FOR
- SET SRMOD=$ORDER(^SRO(136,SRTN,1,SRMOD))
- if 'SRMOD
- QUIT
- Begin DoDot:2
- +7 SET SRMO=$PIECE(^SRO(136,SRTN,1,SRMOD,0),"^")
- +8 if SRFIRST
- WRITE !,?13
- WRITE $PIECE($$MOD^ICPTMOD(SRMO,"I"),"^",2),"-",$PIECE($$MOD^ICPTMOD(SRMO,"I"),"^",3)
- +9 SET SRFIRST=1
- End DoDot:2
- End DoDot:1
- +10 KILL SRDES
- WRITE !
- OTH SET SROTH=0
- FOR
- SET SROTH=$ORDER(^SRO(136,SRTN,3,SROTH))
- if 'SROTH
- QUIT
- Begin DoDot:1
- +1 SET Y=$PIECE($GET(^SRO(136,SRTN,3,SROTH,0)),"^")
- SET Y=$SELECT(Y:$PIECE($$CPT^ICPTCOD(Y),"^",2),1:"")
- DO DES^SROCPT0
- +2 WRITE !,"Other CPT Code: "_SRW
- IF $GET(SRDES(1))'=""
- FOR I=1:1
- if $LENGTH(SRDES(I))'>1
- QUIT
- WRITE !,?5,SRDES(I)
- +3 IF $ORDER(^SRO(136,SRTN,3,SROTH,1,0))
- SET SRFIRST=0
- WRITE !,?3,"Modifier: "
- Begin DoDot:2
- +4 SET SRMOD=0
- FOR
- SET SRMOD=$ORDER(^SRO(136,SRTN,3,SROTH,1,SRMOD))
- if 'SRMOD
- QUIT
- Begin DoDot:3
- +5 SET SRMO=$PIECE(^SRO(136,SRTN,3,SROTH,1,SRMOD,0),"^")
- +6 if SRFIRST
- WRITE !,?13
- WRITE $PIECE($$MOD^ICPTMOD(SRMO,"I"),"^",2),"-",$PIECE($$MOD^ICPTMOD(SRMO,"I"),"^",3)
- +7 SET SRFIRST=1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- KILL SRDES
- WRITE !
- PRESS KILL DIR
- SET DIR(0)="FOA"
- SET DIR("A")="Press ENTER to continue."
- +1 SET DIR("A",1)="CPT Codes should be verified. If need be, report discrepancies to the"
- +2 SET DIR("A",2)="official CPT coder for surgery."
- SET DIR("A",3)=""
- DO ^DIR
- KILL DIR
- +3 QUIT
- OCC ; occur data
- +1 NEW SR40
- SET SR40=" "
- KILL SRSEP,SRDUR
- +2 DO EN^SROCCAT
- KILL ^TMP("SROCC",$JOB),SRO,SROC,SROOC
- +3 FOR SRK=1:1:42
- SET SROC(SRK)=" "
- +4 SET (SRFLG,SRIO,SRPO)=0
- FOR
- SET SRIO=$ORDER(^SRF(SRTN,10,SRIO))
- if 'SRIO
- QUIT
- Begin DoDot:1
- +5 SET SROCC=$PIECE(^SRF(SRTN,10,SRIO,0),U,2)
- if 'SROCC
- QUIT
- +6 SET ^TMP("SROCC",$JOB,SROCC,$EXTRACT($PIECE(^SRF(SRTN,0),U,9),1,7),10)=SRIO
- End DoDot:1
- +7 FOR
- SET SRPO=$ORDER(^SRF(SRTN,16,SRPO))
- if 'SRPO
- QUIT
- Begin DoDot:1
- +8 SET SRDATE=$EXTRACT($PIECE(^SRF(SRTN,16,SRPO,0),U,7),1,7)
- +9 SET X1=$EXTRACT(SRSDATE,1,7)
- SET X2=30
- DO C^%DTC
- +10 IF SRDATE>X
- QUIT
- +11 IF '$GET(SRDATE)
- SET SRDATE=" "
- +12 SET SROCC=$PIECE(^SRF(SRTN,16,SRPO,0),U,2)
- if 'SROCC
- QUIT
- +13 SET ^TMP("SROCC",$JOB,SROCC,SRDATE,16)=SRPO
- End DoDot:1
- +14 IF '$DATA(^TMP("SROCC",$JOB))
- DO OCCEND
- QUIT
- +15 ;remove multiples
- +16 SET SROCC=0
- FOR
- SET SROCC=$ORDER(^TMP("SROCC",$JOB,SROCC))
- if 'SROCC
- QUIT
- SET SROCCDT=$ORDER(^TMP("SROCC",$JOB,SROCC,0))
- SET SRTYPE=$ORDER(^TMP("SROCC",$JOB,SROCC,SROCCDT,0))
- Begin DoDot:1
- +17 IF SROCC=21!(SROCC>28&(SROCC<33))!(SROCC=36)
- Begin DoDot:2
- +18 SET SRDA=^TMP("SROCC",$JOB,SROCC,SROCCDT,SRTYPE)
- SET SRICD=$PIECE(^SRF(SRTN,SRTYPE,SRDA,0),U,3)
- +19 IF SRICD
- SET SROOC(SROCC)=$PIECE($$ICD^SROICD(SRTN,SRICD),"^",2)_"^"_$PIECE(^SRF(SRTN,SRTYPE,SRDA,0),U)
- +20 IF '$TEST
- SET SROOC(SROCC)="NO ICD CODE ENTERED"
- End DoDot:2
- +21 SET ^TMP("SROCC",$JOB,"SR",SROCC,SROCCDT)=""
- End DoDot:1
- +22 SET SRK=1
- SET SRO=""
- SET SROCC=0
- FOR
- SET SROCC=$ORDER(^TMP("SROCC",$JOB,"SR",SROCC))
- if 'SROCC
- QUIT
- SET SROCCDT=""
- FOR
- SET SROCCDT=$ORDER(^TMP("SROCC",$JOB,"SR",SROCC,SROCCDT))
- if SROCCDT=""
- QUIT
- Begin DoDot:1
- +23 IF SROCC=3
- SET SRPO=^TMP("SROCC",$JOB,SROCC,SROCCDT,16)
- IF SRPO
- SET X=$PIECE(^SRF(SRTN,16,SRPO,0),"^",4)
- if X
- SET SRSEP=X
- +24 IF SROCC=12
- SET SRPO=^TMP("SROCC",$JOB,SROCC,SROCCDT,16)
- IF SRPO
- SET X=$PIECE(^SRF(SRTN,16,SRPO,0),"^",8)
- if X
- SET SRDUR=X
- +25 IF SROCC=40
- SET SRPO=^TMP("SROCC",$JOB,SROCC,SROCCDT,16)
- IF SRPO
- SET X=$PIECE(^SRF(SRTN,16,SRPO,0),"^",9,13)
- Begin DoDot:2
- +26 SET SR40=""
- FOR I=1:1:5
- SET SR40=SR40_$JUSTIFY($PIECE(X,"^",I),1)
- End DoDot:2
- +27 SET SROC(SROCC)=SROCCDT
- End DoDot:1
- +28 FOR I=1:1:22,29:1:32,35,36,38
- SET SRO=SRO_$JUSTIFY(SROC(I),7)
- +29 SET X=$GET(SRSEP)
- SET SRO=SRO_$JUSTIFY(X,1)
- IF X
- SET SRSEP=$SELECT(X=2:"SEPSIS",X=3:"SEPTIC SHOCK",1:"SIRS")
- +30 SET X=$GET(SRDUR)
- SET SRO=SRO_$JUSTIFY(X,1)
- IF X
- SET SRDUR=$SELECT(X=2:"<24 HOURS",X=3:"24-72 HOURS",X=4:">72 HOURS",1:"NO SYMPTOMS")
- +31 SET SRO=SRO_$JUSTIFY(SROC(40),7)_$JUSTIFY(SROC(41),7)_SR40_$JUSTIFY(SROC(42),7)
- OCCEND KILL ^TMP("SROCC",$JOB),SRPOCC,SRPOCCD,SRSDATE,SRTYPE,SRDATE,SRDA,SRFLG,SRICD,SRJ,SRK,SROCC,SROCCDT,SRPO,X1,X2
- +1 QUIT