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 Apr 09, 2024@21:43:39 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
