- SROVER ;BIR/MAM - VERIFY CASE ;[ 01/30/01 1:52 PM ]
- ;;3.0;Surgery;**7,34,38,86,88,100,119,177**;24 Jun 93;Build 89
- BEG S (SRSOUT,SRS,SR2)=0 I $D(^SRF(SRTN,.2)),$P(^(.2),"^",3) S SRS=1
- DONE K X I $D(^SRF(SRTN,"VER")),$P(^("VER"),"^")="Y" W !!,"The procedure has already been verified. Do you wish to continue ? YES// " R X:DTIME I '$T!(X["^") G END
- S:'$D(X) X="Y"
- S:X="" X="Y" S X=$E(X) I X["?"!("YyNn"'[X) W !!,"Enter RETURN if you would like to reverify this case, or 'N' to exit",!,"this option." G DONE
- G:"Yy"'[X END
- S S(0)=^SRF(SRTN,0),Y=$E($P(S(0),"^",9),1,7),SRDATE=Y X ^DD("DD") S SRSDATE=Y,DFN=$P(S(0),"^") D DEM^VADPT S SRNM=VADM(1)_" ("_VA("PID")_")"
- N ANS,SRLCK S ANS="NO"
- STRT D PRINT
- I $P($G(^SRF(SRTN,"LOCK")),"^") W !!,"This case has been locked. If you wish to update it, please contact",!,"your Chief of Surgery, or package coordinator." G END
- UP W ! G:SR2 VER W !,"Do you need to update the information above ? NO// " R X:DTIME S:'$T X="^"
- I X["^" W !!,"Verification of this case has not been made." G END
- S (X,ANS)=$E(X)
- I X?.E1C.E W !!,"Your answer has a control character in it, please re-type it.",! G UP
- I "YyNn"'[X W !!,"If the information above is not correct, enter 'YES'. You may then update",!,"any of the fields displayed. Enter RETURN to proceed with verification",!,"of this case." G UP
- S:X="" (X,ANS)="N" I "Yy"[X D CHECK^SROES I SRSOUT S SRLCK=0 K XQUIT G END
- I "Yy"[ANS S SRLCK=1 D PRINT,RT,^SROVER1 G:SRSOUT END G STRT
- VER W !,"Will you verify that the information on your screen is correct ? YES// " R X:DTIME S:'$T X="^" I X["^" W !!,"No action has been taken. " G END
- S X=$E(X)
- I "YyNn"'[X W !,"Enter 'YES' if the procedures, diagnosis, and occurrences are correct",!,"for this case. If you enter 'NO', the case will be left unverified." G VER
- S:X="" X="Y" I "Yy"[X S $P(^SRF(SRTN,"VER"),"^")="Y"
- END S SROERR=SRTN D ^SROERR0
- I $G(SRLCK) D UNLOCK^SROUTL(SRTN)
- W !!,"Press RETURN to continue " R X:DTIME D ^SRSKILL,ADXKILL^SROADX1 W @IOF
- 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
- RT ; start RT logging
- I $D(XRTL) S XRTN="SROVER" D T0^%ZOSV
- Q
- OTHER I '$O(^SRF(SRTN,13,0)) Q
- S OTH=0 F S OTH=$O(^SRF(SRTN,13,OTH)) Q:'OTH!(SRSOUT) D
- .S OTHER=$P(^SRF(SRTN,13,OTH,0),"^"),CPT=$P($G(^SRF(SRTN,13,OTH,2)),"^"),X=$S(CPT:$P($$CPT^ICPTCOD(CPT),"^",2),1:"NOT ENTERED")
- .W !,?3,OTHER_" CPT Code: ",X
- .I CPT,$O(^SRF(SRTN,13,OTH,"MOD",0)) D W !,?10,SRX
- ..S (SRCOMMA,SRI)=0,SRCMOD="",SRX="Modifiers: -" F S SRI=$O(^SRF(SRTN,13,OTH,"MOD",SRI)) Q:'SRI D
- ...S SRM=$P(^SRF(SRTN,13,OTH,"MOD",SRI,0),"^"),SRCMOD=$P($$MOD^ICPTMOD(SRM,"I"),"^",2)
- ...S SRX=SRX_$S(SRCOMMA:",",1:"")_SRCMOD,SRCOMMA=1
- .D OTHADXD^SROADX1
- Q
- PRINT ; print information
- W @IOF,!,SRNM,?52,"Operation Date: "_SRSDATE,! F I=1:1:80 W "-"
- K ^UTILITY($J,"W") W !,"1. Indications for Operation:" S SRIND=0 F I=0:0 S SRIND=$O(^SRF(SRTN,40,SRIND)) Q:'SRIND S X=^SRF(SRTN,40,SRIND,0),DIWL=3,DIWR=76,DIWF="N" D ^DIWP
- I $D(^UTILITY($J,"W")) F V=1:1:^UTILITY($J,"W",3)-1 W !,?3,^UTILITY($J,"W",3,V,0)
- S S("OP")=^SRF(SRTN,"OP"),CPT=$P(S("OP"),"^",2) S SROPER=$P(S("OP"),"^")
- 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=""
- S X=$S(CPT:$P($$CPT^ICPTCOD(CPT),"^",2),1:"NOT ENTERED")
- W !,"2. Principal CPT Code: ",X I CPT K SRDES S X=$$CPTD^ICPTCOD(CPT,"SRDES") I $O(SRDES(0)) F I=1:1:X W !,?5,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)
- ..S SRX=SRX_$S(SRCOMMA:",",1:"")_SRCMOD,SRCOMMA=1
- S SRMSG="NO Assoc. DX ENTERED",SRASDX="Assoc. DX: "
- D PADXD^SROADX1
- W !,"3. Principal Procedure: ",?24,SROPS(1) I $D(SROPS(2)) W !,?24,SROPS(2) I $D(SROPS(3)) W !,?24,SROPS(3)
- W !,"4. Other Procedures: ",?24 D OTHER
- W !,"5. Postoperative Diagnosis: " I $D(^SRF(SRTN,34)) W ?30,$P(^(34),"^")
- W !,"6. Intraoperative Occurrences: "_$S($O(^SRF(SRTN,10,0)):"** INFORMATION ENTERED **",1:"NO OCCURRENCES HAVE 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 "_$$ICDSTR^SROICD(SRTN)_": "_SRDIAG
- W ! F LINE=1:1:80 W "-"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROVER 4638 printed Feb 19, 2025@00:13:02 Page 2
- SROVER ;BIR/MAM - VERIFY CASE ;[ 01/30/01 1:52 PM ]
- +1 ;;3.0;Surgery;**7,34,38,86,88,100,119,177**;24 Jun 93;Build 89
- BEG SET (SRSOUT,SRS,SR2)=0
- IF $DATA(^SRF(SRTN,.2))
- IF $PIECE(^(.2),"^",3)
- SET SRS=1
- DONE KILL X
- IF $DATA(^SRF(SRTN,"VER"))
- IF $PIECE(^("VER"),"^")="Y"
- WRITE !!,"The procedure has already been verified. Do you wish to continue ? YES// "
- READ X:DTIME
- IF '$TEST!(X["^")
- GOTO END
- +1 if '$DATA(X)
- SET X="Y"
- +2 if X=""
- SET X="Y"
- SET X=$EXTRACT(X)
- IF X["?"!("YyNn"'[X)
- WRITE !!,"Enter RETURN if you would like to reverify this case, or 'N' to exit",!,"this option."
- GOTO DONE
- +3 if "Yy"'[X
- GOTO END
- +4 SET S(0)=^SRF(SRTN,0)
- SET Y=$EXTRACT($PIECE(S(0),"^",9),1,7)
- SET SRDATE=Y
- XECUTE ^DD("DD")
- SET SRSDATE=Y
- SET DFN=$PIECE(S(0),"^")
- DO DEM^VADPT
- SET SRNM=VADM(1)_" ("_VA("PID")_")"
- +5 NEW ANS,SRLCK
- SET ANS="NO"
- STRT DO PRINT
- +1 IF $PIECE($GET(^SRF(SRTN,"LOCK")),"^")
- WRITE !!,"This case has been locked. If you wish to update it, please contact",!,"your Chief of Surgery, or package coordinator."
- GOTO END
- UP WRITE !
- if SR2
- GOTO VER
- WRITE !,"Do you need to update the information above ? NO// "
- READ X:DTIME
- if '$TEST
- SET X="^"
- +1 IF X["^"
- WRITE !!,"Verification of this case has not been made."
- GOTO END
- +2 SET (X,ANS)=$EXTRACT(X)
- +3 IF X?.E1C.E
- WRITE !!,"Your answer has a control character in it, please re-type it.",!
- GOTO UP
- +4 IF "YyNn"'[X
- WRITE !!,"If the information above is not correct, enter 'YES'. You may then update",!,"any of the fields displayed. Enter RETURN to proceed with verification",!,"of this case."
- GOTO UP
- +5 if X=""
- SET (X,ANS)="N"
- IF "Yy"[X
- DO CHECK^SROES
- IF SRSOUT
- SET SRLCK=0
- KILL XQUIT
- GOTO END
- +6 IF "Yy"[ANS
- SET SRLCK=1
- DO PRINT
- DO RT
- DO ^SROVER1
- if SRSOUT
- GOTO END
- GOTO STRT
- VER WRITE !,"Will you verify that the information on your screen is correct ? YES// "
- READ X:DTIME
- if '$TEST
- SET X="^"
- IF X["^"
- WRITE !!,"No action has been taken. "
- GOTO END
- +1 SET X=$EXTRACT(X)
- +2 IF "YyNn"'[X
- WRITE !,"Enter 'YES' if the procedures, diagnosis, and occurrences are correct",!,"for this case. If you enter 'NO', the case will be left unverified."
- GOTO VER
- +3 if X=""
- SET X="Y"
- IF "Yy"[X
- SET $PIECE(^SRF(SRTN,"VER"),"^")="Y"
- END SET SROERR=SRTN
- DO ^SROERR0
- +1 IF $GET(SRLCK)
- DO UNLOCK^SROUTL(SRTN)
- +2 WRITE !!,"Press RETURN to continue "
- READ X:DTIME
- DO ^SRSKILL
- DO ADXKILL^SROADX1
- WRITE @IOF
- +3 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
- RT ; start RT logging
- +1 IF $DATA(XRTL)
- SET XRTN="SROVER"
- DO T0^%ZOSV
- +2 QUIT
- OTHER IF '$ORDER(^SRF(SRTN,13,0))
- QUIT
- +1 SET OTH=0
- FOR
- SET OTH=$ORDER(^SRF(SRTN,13,OTH))
- if 'OTH!(SRSOUT)
- QUIT
- Begin DoDot:1
- +2 SET OTHER=$PIECE(^SRF(SRTN,13,OTH,0),"^")
- SET CPT=$PIECE($GET(^SRF(SRTN,13,OTH,2)),"^")
- SET X=$SELECT(CPT:$PIECE($$CPT^ICPTCOD(CPT),"^",2),1:"NOT ENTERED")
- +3 WRITE !,?3,OTHER_" CPT Code: ",X
- +4 IF CPT
- IF $ORDER(^SRF(SRTN,13,OTH,"MOD",0))
- Begin DoDot:2
- +5 SET (SRCOMMA,SRI)=0
- SET SRCMOD=""
- SET SRX="Modifiers: -"
- FOR
- SET SRI=$ORDER(^SRF(SRTN,13,OTH,"MOD",SRI))
- if 'SRI
- QUIT
- Begin DoDot:3
- +6 SET SRM=$PIECE(^SRF(SRTN,13,OTH,"MOD",SRI,0),"^")
- SET SRCMOD=$PIECE($$MOD^ICPTMOD(SRM,"I"),"^",2)
- +7 SET SRX=SRX_$SELECT(SRCOMMA:",",1:"")_SRCMOD
- SET SRCOMMA=1
- End DoDot:3
- End DoDot:2
- WRITE !,?10,SRX
- +8 DO OTHADXD^SROADX1
- End DoDot:1
- +9 QUIT
- PRINT ; print information
- +1 WRITE @IOF,!,SRNM,?52,"Operation Date: "_SRSDATE,!
- FOR I=1:1:80
- WRITE "-"
- +2 KILL ^UTILITY($JOB,"W")
- WRITE !,"1. Indications for Operation:"
- SET SRIND=0
- FOR I=0:0
- SET SRIND=$ORDER(^SRF(SRTN,40,SRIND))
- if 'SRIND
- QUIT
- SET X=^SRF(SRTN,40,SRIND,0)
- SET DIWL=3
- SET DIWR=76
- SET DIWF="N"
- DO ^DIWP
- +3 IF $DATA(^UTILITY($JOB,"W"))
- FOR V=1:1:^UTILITY($JOB,"W",3)-1
- WRITE !,?3,^UTILITY($JOB,"W",3,V,0)
- +4 SET S("OP")=^SRF(SRTN,"OP")
- SET CPT=$PIECE(S("OP"),"^",2)
- SET SROPER=$PIECE(S("OP"),"^")
- +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 SET X=$SELECT(CPT:$PIECE($$CPT^ICPTCOD(CPT),"^",2),1:"NOT ENTERED")
- +7 WRITE !,"2. Principal CPT Code: ",X
- IF CPT
- KILL SRDES
- SET X=$$CPTD^ICPTCOD(CPT,"SRDES")
- IF $ORDER(SRDES(0))
- FOR I=1:1:X
- WRITE !,?5,SRDES(I)
- +8 IF CPT
- IF $ORDER(^SRF(SRTN,"OPMOD",0))
- Begin DoDot:1
- +9 SET (SRCOMMA,SRI)=0
- SET SRCMOD=""
- SET SRX="Modifiers: -"
- FOR
- SET SRI=$ORDER(^SRF(SRTN,"OPMOD",SRI))
- if 'SRI
- QUIT
- Begin DoDot:2
- +10 SET SRM=$PIECE(^SRF(SRTN,"OPMOD",SRI,0),"^")
- SET SRCMOD=$PIECE($$MOD^ICPTMOD(SRM,"I"),"^",2)
- +11 SET SRX=SRX_$SELECT(SRCOMMA:",",1:"")_SRCMOD
- SET SRCOMMA=1
- End DoDot:2
- End DoDot:1
- WRITE !,?10,SRX
- +12 SET SRMSG="NO Assoc. DX ENTERED"
- SET SRASDX="Assoc. DX: "
- +13 DO PADXD^SROADX1
- +14 WRITE !,"3. Principal Procedure: ",?24,SROPS(1)
- IF $DATA(SROPS(2))
- WRITE !,?24,SROPS(2)
- IF $DATA(SROPS(3))
- WRITE !,?24,SROPS(3)
- +15 WRITE !,"4. Other Procedures: ",?24
- DO OTHER
- +16 WRITE !,"5. Postoperative Diagnosis: "
- IF $DATA(^SRF(SRTN,34))
- WRITE ?30,$PIECE(^(34),"^")
- +17 WRITE !,"6. Intraoperative Occurrences: "_$SELECT($ORDER(^SRF(SRTN,10,0)):"** INFORMATION ENTERED **",1:"NO OCCURRENCES HAVE BEEN ENTERED")
- +18 WRITE !,"7. Principal Pre-OP Diagnosis: "
- IF $DATA(^SRF(SRTN,33))
- WRITE $PIECE(^(33),"^")
- +19 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)
- +20 WRITE !,"8. Principal Pre-OP Diagnosis Code "_$$ICDSTR^SROICD(SRTN)_": "_SRDIAG
- +21 WRITE !
- FOR LINE=1:1:80
- WRITE "-"
- +22 QUIT
