- SROVER2 ;BIR/ADM - Case Coding and Verification ; 8/10/04 3:00pm
- ;;3.0;Surgery;**86,88,100,127,119,177**;24 Jun 93;Build 89
- I '$D(SRSITE) D ^SROVAR I '$D(SRSITE) S XQUIT="" Q
- I '$G(SRTN) D ^SROPS1 I '$D(SRTN) S XQUIT="" Q
- BEG N SRDES,SRDX,SREDIT,SRMOD,SRNON,SRSEL,SRTXT S (SREDIT,SRMOD,SRSOUT,SRS,SR2)=0 K ^TMP("SRV1",$J),^TMP("SRV2",$J) I $D(^SRF(SRTN,.2)),$P(^(.2),"^",3) S SRS=1
- S S(0)=^SRF(SRTN,0),Y=$P(S(0),"^",9),SRDATE=Y D D^DIQ S SRSDATE=Y,DFN=$P(S(0),"^") D DEM^VADPT S SRNM=VADM(1)_" ("_VA("PID")_")"
- S SRNON=$S($P($G(^SRF(SRTN,"NON")),"^")="Y":1,1:0)
- PRINT ; print information
- D HDR S S("OP")=^SRF(SRTN,"OP"),CPT=$P(S("OP"),"^",2),SROPER=$P(S("OP"),"^")
- S SRJ=0,Y="" F S SRJ=$O(^SRF(SRTN,"OPMOD",SRJ)) Q:'SRJ S Y=Y_$S($L(Y):",",1:"")_^SRF(SRTN,"OPMOD",SRJ,0)
- S ^TMP("SRV1",$J,"OP")=SROPER_"^"_CPT_"^"_Y
- S SRCPT="" I CPT S Y=$$CPT^ICPTCOD(CPT,$P($G(^SRF(SRTN,0)),"^",9)),SRCPT=$P(Y,"^",2)_" "_$P(Y,"^",3)
- K SROPS,MM,MMM S:$L(SROPER)<45 SROPS(1)=SROPER I $L(SROPER)>44 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
- W !,"1. Principal Procedure: ",?24,SROPS(1) I $D(SROPS(2)) W !,?24,SROPS(2) I $D(SROPS(3)) W !,?24,SROPS(3)
- W !,"2. Principal CPT Code: ",?24,$S(CPT:SRCPT,1:"NOT ENTERED")
- I CPT K SRDES S X=$$CPTD^ICPTCOD(CPT,"SRDES",,$P($G(^SRF(SRTN,0)),"^",9)) I $O(SRDES(0)) F I=1:1:X W !,?6,SRDES(I)
- I CPT,$O(^SRF(SRTN,"OPMOD",0)) D W !,?10,SRX
- .S (SRCOMMA,SRI)=0,SRCMOD="",SRX="Modifiers: -" F S SRI=$O(^SRF(SRTN,"OPMOD",SRI)) Q:'SRI D
- ..S SRM=$P(^SRF(SRTN,"OPMOD",SRI,0),"^"),SRCMOD=$P($$MOD^ICPTMOD(SRM,"I"),"^",2) K SRM
- ..S SRX=SRX_$S(SRCOMMA:",",1:"")_SRCMOD,SRCOMMA=1
- S SRMSG="NO Assoc. DX ENTERED"
- D PADXD^SROADX1
- W !,"3. Other Procedures: "_$S($O(^SRF(SRTN,13,0)):"** INFORMATION ENTERED **",1:"NO OTHER PROCEDURES HAVE BEEN ENTERED")
- S X=0 F S X=$O(^SRF(SRTN,13,X)) Q:'X D S ^TMP("SRV1",$J,13,X)=$P($G(^SRF(SRTN,13,X,0)),"^")_"^"_$P($G(^SRF(SRTN,13,X,2)),"^")_"^"_Y
- .S SRJ=0,Y="" F S SRJ=$O(^SRF(SRTN,13,X,"MOD",SRJ)) Q:'SRJ S Y=Y_$S($L(Y):",",1:"")_^SRF(SRTN,13,X,"MOD",SRJ,0)
- I SRNON S SRTXT=$P($G(^SRF(SRTN,33)),"^",2) W !,"4. Principal Diagnosis: "_SRTXT
- I 'SRNON S SRTXT=$P($G(^SRF(SRTN,34)),"^") W !,"4. Postoperative Diagnosis: "_SRTXT
- S SRDIAG="NOT ENTERED",SRDX=$P($G(^SRF(SRTN,34)),"^",2) I SRDX S SRDIAG=$$ICD^SROICD(SRTN,SRDX),SRDIAG=$P(SRDIAG,"^",2)_" "_$P(SRDIAG,"^",4)
- W !,"5. Principal Diagnosis Code: "_SRDIAG S ^TMP("SRV1",$J,34)=SRTXT_"^"_SRDX
- W !,"6. Other Postop Diagnosis: "_$S($O(^SRF(SRTN,15,0)):"** INFORMATION ENTERED **",1:"NO OTHER POSTOP DIAGNOSIS HAS BEEN ENTERED")
- W !,"7. Principal Pre-OP Diagnosis: " I $D(^SRF(SRTN,33)) W $P(^(33),"^")
- S SRDIAG="NOT ENTERED",SRDX=$P($G(^SRF(SRTN,34)),"^",3) I SRDX S SRDIAG=$$ICD^SROICD(SRTN,SRDX),SRDIAG=$P(SRDIAG,"^",2)_" "_$P(SRDIAG,"^",4)
- W !,"8. Principal Pre-OP Diagnosis Code: "_SRDIAG
- S X=0 F S X=$O(^SRF(SRTN,15,X)) Q:'X S Y=$G(^SRF(SRTN,15,X,0)),^TMP("SRV1",$J,15,X)=$P(Y,"^")_"^"_$P(Y,"^",3)
- W ! F LINE=1:1:80 W "-"
- N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
- D ^SROVER3,MOD G:SRSOUT END G:'SREDIT PRINT
- END K ^TMP("SRV1",$J),^TMP("SRV2",$J) S SROERR=SRTN D ^SROERR0,^SRSKILL,ADXKILL^SROADX1 W @IOF
- I $G(SRLCK) D UNLOCK^SROUTL(SRTN)
- Q
- HDR W @IOF,!,SRNM,!,"Operation Date: "_SRSDATE,?40,"Case #",SRTN,! F I=1:1:80 W "-"
- Q
- LOOP ; break procedure if greater than 45 characters
- S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<45 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
- Q
- ORPT ; print operation/procedure report
- N SRNON S SRNON=$S($P($G(^SRF(SRTN,"NON")),"^")="Y":1,1:0) I SRNON D CODE^SRONON Q
- D CODE^SROPRPT
- Q
- NRPT ; print nurse intraoperative report
- N SRNON S SRNON=$S($P($G(^SRF(SRTN,"NON")),"^")="Y":1,1:0) I SRNON W !!,?5,"Nurse Intraoperative Report NOT available on Non-OR Procedure",! D PRESS^SROVER3 W @IOF Q
- D CODE^SRONIN
- Q
- MOD ; if data changed set coder verification field
- D CHECK I SRMOD S $P(^SRF(SRTN,"VER"),"^",2)=DUZ
- Q
- CHECK ; check for changes to data
- S X=$P(^SRF(SRTN,"OP"),"^",1,2) D I X'=^TMP("SRV1",$J,"OP") S SRMOD=1 Q
- .S SRJ=0,Y="" F S SRJ=$O(^SRF(SRTN,"OPMOD",SRJ)) Q:'SRJ S Y=Y_$S($L(Y):",",1:"")_^SRF(SRTN,"OPMOD",SRJ,0)
- .S X=X_"^"_Y
- S X=0 F S X=$O(^SRF(SRTN,13,X)) Q:'X!SRMOD D S ^TMP("SRV2",$J,13,X)=$P($G(^SRF(SRTN,13,X,0)),"^")_"^"_$P($G(^SRF(SRTN,13,X,2)),"^")_"^"_Y I ^TMP("SRV2",$J,13,X)'=$G(^TMP("SRV1",$J,13,X)) S SRMOD=1 Q
- .S SRJ=0,Y="" F S SRJ=$O(^SRF(SRTN,13,X,"MOD",SRJ)) Q:'SRJ S Y=Y_$S($L(Y):",",1:"")_^SRF(SRTN,13,X,"MOD",SRJ,0)
- Q:SRMOD S X=0 F S X=$O(^TMP("SRV1",$J,13,X)) Q:'X!SRMOD I ^TMP("SRV1",$J,13,X)'=$G(^TMP("SRV2",$J,13,X)) S SRMOD=1 Q
- Q:SRMOD I SRNON S X=$P($G(^SRF(SRTN,33)),"^",2)_"^"_$P($G(^SRF(SRTN,34)),"^",2) I X'=^TMP("SRV1",$J,34) S SRMOD=1 Q
- I 'SRNON S X=$P($G(^SRF(SRTN,34)),"^",1,2) I X'=^TMP("SRV1",$J,34) S SRMOD=1 Q
- S X=0 F S X=$O(^SRF(SRTN,15,X)) Q:'X!SRMOD S Y=$G(^SRF(SRTN,15,X,0)),^TMP("SRV2",$J,15,X)=$P(Y,"^")_"^"_$P(Y,"^",3) I ^TMP("SRV2",$J,15,X)'=$G(^TMP("SRV1",$J,15,X)) S SRMOD=1 Q
- Q:SRMOD S X=0 F S X=$O(^TMP("SRV1",$J,15,X)) Q:'X!SRMOD I ^TMP("SRV1",$J,15,X)'=$G(^TMP("SRV2",$J,15,X)) S SRMOD=1 Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROVER2 5195 printed Feb 19, 2025@00:13:04 Page 2
- SROVER2 ;BIR/ADM - Case Coding and Verification ; 8/10/04 3:00pm
- +1 ;;3.0;Surgery;**86,88,100,127,119,177**;24 Jun 93;Build 89
- +2 IF '$DATA(SRSITE)
- DO ^SROVAR
- IF '$DATA(SRSITE)
- SET XQUIT=""
- QUIT
- +3 IF '$GET(SRTN)
- DO ^SROPS1
- IF '$DATA(SRTN)
- SET XQUIT=""
- QUIT
- BEG NEW SRDES,SRDX,SREDIT,SRMOD,SRNON,SRSEL,SRTXT
- SET (SREDIT,SRMOD,SRSOUT,SRS,SR2)=0
- KILL ^TMP("SRV1",$JOB),^TMP("SRV2",$JOB)
- IF $DATA(^SRF(SRTN,.2))
- IF $PIECE(^(.2),"^",3)
- SET SRS=1
- +1 SET S(0)=^SRF(SRTN,0)
- SET Y=$PIECE(S(0),"^",9)
- SET SRDATE=Y
- DO D^DIQ
- SET SRSDATE=Y
- SET DFN=$PIECE(S(0),"^")
- DO DEM^VADPT
- SET SRNM=VADM(1)_" ("_VA("PID")_")"
- +2 SET SRNON=$SELECT($PIECE($GET(^SRF(SRTN,"NON")),"^")="Y":1,1:0)
- PRINT ; print information
- +1 DO HDR
- SET S("OP")=^SRF(SRTN,"OP")
- SET CPT=$PIECE(S("OP"),"^",2)
- SET SROPER=$PIECE(S("OP"),"^")
- +2 SET SRJ=0
- SET Y=""
- FOR
- SET SRJ=$ORDER(^SRF(SRTN,"OPMOD",SRJ))
- if 'SRJ
- QUIT
- SET Y=Y_$SELECT($LENGTH(Y):",",1:"")_^SRF(SRTN,"OPMOD",SRJ,0)
- +3 SET ^TMP("SRV1",$JOB,"OP")=SROPER_"^"_CPT_"^"_Y
- +4 SET SRCPT=""
- IF CPT
- SET Y=$$CPT^ICPTCOD(CPT,$PIECE($GET(^SRF(SRTN,0)),"^",9))
- SET SRCPT=$PIECE(Y,"^",2)_" "_$PIECE(Y,"^",3)
- +5 KILL SROPS,MM,MMM
- if $LENGTH(SROPER)<45
- SET SROPS(1)=SROPER
- IF $LENGTH(SROPER)>44
- SET SROPER=SROPER_" "
- FOR M=1:1
- DO LOOP
- if MMM=""
- QUIT
- +6 WRITE !,"1. Principal Procedure: ",?24,SROPS(1)
- IF $DATA(SROPS(2))
- WRITE !,?24,SROPS(2)
- IF $DATA(SROPS(3))
- WRITE !,?24,SROPS(3)
- +7 WRITE !,"2. Principal CPT Code: ",?24,$SELECT(CPT:SRCPT,1:"NOT ENTERED")
- +8 IF CPT
- KILL SRDES
- SET X=$$CPTD^ICPTCOD(CPT,"SRDES",,$PIECE($GET(^SRF(SRTN,0)),"^",9))
- IF $ORDER(SRDES(0))
- FOR I=1:1:X
- WRITE !,?6,SRDES(I)
- +9 IF CPT
- IF $ORDER(^SRF(SRTN,"OPMOD",0))
- Begin DoDot:1
- +10 SET (SRCOMMA,SRI)=0
- SET SRCMOD=""
- SET SRX="Modifiers: -"
- FOR
- SET SRI=$ORDER(^SRF(SRTN,"OPMOD",SRI))
- if 'SRI
- QUIT
- Begin DoDot:2
- +11 SET SRM=$PIECE(^SRF(SRTN,"OPMOD",SRI,0),"^")
- SET SRCMOD=$PIECE($$MOD^ICPTMOD(SRM,"I"),"^",2)
- KILL SRM
- +12 SET SRX=SRX_$SELECT(SRCOMMA:",",1:"")_SRCMOD
- SET SRCOMMA=1
- End DoDot:2
- End DoDot:1
- WRITE !,?10,SRX
- +13 SET SRMSG="NO Assoc. DX ENTERED"
- +14 DO PADXD^SROADX1
- +15 WRITE !,"3. Other Procedures: "_$SELECT($ORDER(^SRF(SRTN,13,0)):"** INFORMATION ENTERED **",1:"NO OTHER PROCEDURES HAVE BEEN ENTERED")
- +16 SET X=0
- FOR
- SET X=$ORDER(^SRF(SRTN,13,X))
- if 'X
- QUIT
- Begin DoDot:1
- +17 SET SRJ=0
- SET Y=""
- FOR
- SET SRJ=$ORDER(^SRF(SRTN,13,X,"MOD",SRJ))
- if 'SRJ
- QUIT
- SET Y=Y_$SELECT($LENGTH(Y):",",1:"")_^SRF(SRTN,13,X,"MOD",SRJ,0)
- End DoDot:1
- SET ^TMP("SRV1",$JOB,13,X)=$PIECE($GET(^SRF(SRTN,13,X,0)),"^")_"^"_$PIECE($GET(^SRF(SRTN,13,X,2)),"^")_"^"_Y
- +18 IF SRNON
- SET SRTXT=$PIECE($GET(^SRF(SRTN,33)),"^",2)
- WRITE !,"4. Principal Diagnosis: "_SRTXT
- +19 IF 'SRNON
- SET SRTXT=$PIECE($GET(^SRF(SRTN,34)),"^")
- WRITE !,"4. Postoperative Diagnosis: "_SRTXT
- +20 SET SRDIAG="NOT ENTERED"
- SET SRDX=$PIECE($GET(^SRF(SRTN,34)),"^",2)
- IF SRDX
- SET SRDIAG=$$ICD^SROICD(SRTN,SRDX)
- SET SRDIAG=$PIECE(SRDIAG,"^",2)_" "_$PIECE(SRDIAG,"^",4)
- +21 WRITE !,"5. Principal Diagnosis Code: "_SRDIAG
- SET ^TMP("SRV1",$JOB,34)=SRTXT_"^"_SRDX
- +22 WRITE !,"6. Other Postop Diagnosis: "_$SELECT($ORDER(^SRF(SRTN,15,0)):"** INFORMATION ENTERED **",1:"NO OTHER POSTOP DIAGNOSIS HAS BEEN ENTERED")
- +23 WRITE !,"7. Principal Pre-OP Diagnosis: "
- IF $DATA(^SRF(SRTN,33))
- WRITE $PIECE(^(33),"^")
- +24 SET SRDIAG="NOT ENTERED"
- SET SRDX=$PIECE($GET(^SRF(SRTN,34)),"^",3)
- IF SRDX
- SET SRDIAG=$$ICD^SROICD(SRTN,SRDX)
- SET SRDIAG=$PIECE(SRDIAG,"^",2)_" "_$PIECE(SRDIAG,"^",4)
- +25 WRITE !,"8. Principal Pre-OP Diagnosis Code: "_SRDIAG
- +26 SET X=0
- FOR
- SET X=$ORDER(^SRF(SRTN,15,X))
- if 'X
- QUIT
- SET Y=$GET(^SRF(SRTN,15,X,0))
- SET ^TMP("SRV1",$JOB,15,X)=$PIECE(Y,"^")_"^"_$PIECE(Y,"^",3)
- +27 WRITE !
- FOR LINE=1:1:80
- WRITE "-"
- +28 NEW SRLCK
- SET SRLCK=$$LOCK^SROUTL(SRTN)
- IF 'SRLCK
- GOTO END
- +29 DO ^SROVER3
- DO MOD
- if SRSOUT
- GOTO END
- if 'SREDIT
- GOTO PRINT
- END KILL ^TMP("SRV1",$JOB),^TMP("SRV2",$JOB)
- SET SROERR=SRTN
- DO ^SROERR0
- DO ^SRSKILL
- DO ADXKILL^SROADX1
- WRITE @IOF
- +1 IF $GET(SRLCK)
- DO UNLOCK^SROUTL(SRTN)
- +2 QUIT
- HDR WRITE @IOF,!,SRNM,!,"Operation Date: "_SRSDATE,?40,"Case #",SRTN,!
- FOR I=1:1:80
- WRITE "-"
- +1 QUIT
- LOOP ; break procedure if greater than 45 characters
- +1 SET SROPS(M)=""
- FOR LOOP=1:1
- SET MM=$PIECE(SROPER," ")
- SET MMM=$PIECE(SROPER," ",2,200)
- if MMM=""
- QUIT
- if $LENGTH(SROPS(M))+$LENGTH(MM)'<45
- QUIT
- SET SROPS(M)=SROPS(M)_MM_" "
- SET SROPER=MMM
- +2 QUIT
- ORPT ; print operation/procedure report
- +1 NEW SRNON
- SET SRNON=$SELECT($PIECE($GET(^SRF(SRTN,"NON")),"^")="Y":1,1:0)
- IF SRNON
- DO CODE^SRONON
- QUIT
- +2 DO CODE^SROPRPT
- +3 QUIT
- NRPT ; print nurse intraoperative report
- +1 NEW SRNON
- SET SRNON=$SELECT($PIECE($GET(^SRF(SRTN,"NON")),"^")="Y":1,1:0)
- IF SRNON
- WRITE !!,?5,"Nurse Intraoperative Report NOT available on Non-OR Procedure",!
- DO PRESS^SROVER3
- WRITE @IOF
- QUIT
- +2 DO CODE^SRONIN
- +3 QUIT
- MOD ; if data changed set coder verification field
- +1 DO CHECK
- IF SRMOD
- SET $PIECE(^SRF(SRTN,"VER"),"^",2)=DUZ
- +2 QUIT
- CHECK ; check for changes to data
- +1 SET X=$PIECE(^SRF(SRTN,"OP"),"^",1,2)
- Begin DoDot:1
- +2 SET SRJ=0
- SET Y=""
- FOR
- SET SRJ=$ORDER(^SRF(SRTN,"OPMOD",SRJ))
- if 'SRJ
- QUIT
- SET Y=Y_$SELECT($LENGTH(Y):",",1:"")_^SRF(SRTN,"OPMOD",SRJ,0)
- +3 SET X=X_"^"_Y
- End DoDot:1
- IF X'=^TMP("SRV1",$JOB,"OP")
- SET SRMOD=1
- QUIT
- +4 SET X=0
- FOR
- SET X=$ORDER(^SRF(SRTN,13,X))
- if 'X!SRMOD
- QUIT
- Begin DoDot:1
- +5 SET SRJ=0
- SET Y=""
- FOR
- SET SRJ=$ORDER(^SRF(SRTN,13,X,"MOD",SRJ))
- if 'SRJ
- QUIT
- SET Y=Y_$SELECT($LENGTH(Y):",",1:"")_^SRF(SRTN,13,X,"MOD",SRJ,0)
- End DoDot:1
- SET ^TMP("SRV2",$JOB,13,X)=$PIECE($GET(^SRF(SRTN,13,X,0)),"^")_"^"_$PIECE($GET(^SRF(SRTN,13,X,2)),"^")_"^"_Y
- IF ^TMP("SRV2",$JOB,13,X)'=$GET(^TMP("SRV1",$JOB,13,X))
- SET SRMOD=1
- QUIT
- +6 if SRMOD
- QUIT
- SET X=0
- FOR
- SET X=$ORDER(^TMP("SRV1",$JOB,13,X))
- if 'X!SRMOD
- QUIT
- IF ^TMP("SRV1",$JOB,13,X)'=$GET(^TMP("SRV2",$JOB,13,X))
- SET SRMOD=1
- QUIT
- +7 if SRMOD
- QUIT
- IF SRNON
- SET X=$PIECE($GET(^SRF(SRTN,33)),"^",2)_"^"_$PIECE($GET(^SRF(SRTN,34)),"^",2)
- IF X'=^TMP("SRV1",$JOB,34)
- SET SRMOD=1
- QUIT
- +8 IF 'SRNON
- SET X=$PIECE($GET(^SRF(SRTN,34)),"^",1,2)
- IF X'=^TMP("SRV1",$JOB,34)
- SET SRMOD=1
- QUIT
- +9 SET X=0
- FOR
- SET X=$ORDER(^SRF(SRTN,15,X))
- if 'X!SRMOD
- QUIT
- SET Y=$GET(^SRF(SRTN,15,X,0))
- SET ^TMP("SRV2",$JOB,15,X)=$PIECE(Y,"^")_"^"_$PIECE(Y,"^",3)
- IF ^TMP("SRV2",$JOB,15,X)'=$GET(^TMP("SRV1",$JOB,15,X))
- SET SRMOD=1
- QUIT
- +10 if SRMOD
- QUIT
- SET X=0
- FOR
- SET X=$ORDER(^TMP("SRV1",$JOB,15,X))
- if 'X!SRMOD
- QUIT
- IF ^TMP("SRV1",$JOB,15,X)'=$GET(^TMP("SRV2",$JOB,15,X))
- SET SRMOD=1
- QUIT
- +11 QUIT