SROACOD ;BIR/SJA - ALERT CODERS OF POTENTIAL CODING ISSUES ;04/18/06
;;3.0;Surgery;**146,152,177,184**;24 Jun 93;Build 35
I '$D(SRTN) K SRNEWOP D ^SROPS G:'$D(SRTN) END S SRTN("KILL")=1
N I,J,SRCPTP,SRLN,SRNODE0,SRPOST,SRTXT,SRSOUT,SRSUPCPT,X,XX,Y
S SRSOUT=0,SRSUPCPT=1 D ^SROAUTL
START G:SRSOUT END K SRAOTH
D HDR^SROAUTL
W !,"The following ""final"" codes have been entered for the case.",!!
S X=$P($G(^SRO(136,SRTN,0)),"^",2) I X S Y=$P($$CPT^ICPTCOD(X),"^",2) D SSPRIN^SROCPT0 S X=Y
W "Principal CPT Code: ",?30,$S($L(X):X,1:"NOT ENTERED") S SRCPTP=X
N SRPROC,K,SRL
S SRPROC(1)="",SRL=60,K=1 D OTH^SROUTLN W !,"Other CPT Codes: ",?30,$S(SRPROC(1)="":"NOT ENTERED",1:"")
F I=1:1 Q:'$D(SRPROC(I)) W:I=1 ?20,$P(SRPROC(I),", ",2,99),! W:I'=1 ?20,SRPROC(I),!
S X=$P($G(^SRO(136,SRTN,0)),"^",3) S:X X=$$ICD^SROICD(SRTN,X),X=$P(X,"^",2)_" "_$P(X,"^",4)
W "Postop Diagnosis Code "_$$ICDSTR^SROICD(SRTN)_": ",?30,$S(X'="":X,1:"NOT ENTERED"),! S SRPOST=X
W !!,"If you believe that the information coded is not correct and would like to",!,"alert the coders of the potential issue, enter a brief description of your",!,"concern below.",!
D ASK G:SRSOUT END
K ^TMP($J,"SRC")
ED W ! S DIC="^TMP($J,""SRC"",",DIWESUB="Coding Discrepancy Comments" D EN^DIWE
I '$D(^TMP($J,"SRC")) W !,"NOTE: You have exited the field without entering comments. ",!
W ! K DIR S DIR("A",1)="1. Transmit Message",DIR("A",2)="2. Edit Text",DIR("A",3)="",DIR("A")="Select Number: "
S DIR(0)="NA^1:2",DIR("B")=1,DIR("?",1)="Enter <RET> or '1' to Transmit Message,"
S DIR("?")="enter '2' to Edit the text or enter '^' to exit." D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) G END
I Y=2 G ED
MSG I '$P($G(^SRO(136,SRTN,10)),"^")&('$P($G(^SRO(133,SRSITE,7)),"^",2)) D ERR G END
K SR,XMY S SRNODE0=$G(^SRF(SRTN,0))
S SR(1)="Patient: "_$E(VADM(1),1,20)_$J("",30-$L(VADM(1)))_" Case #: "_SRTN
S Y=$P(SRNODE0,"^",9) D DD^%DT S SR(2)="Operation Date: "_Y
S SR(3)=""
S SR(4)="The following ""final"" codes have been entered for the case."
S DFN=$P(SRNODE0,"^") D DEM^VADPT
S SR(5)=""
S SR(6)=" Principal CPT Code: "_SRCPTP
S SRLN=6 F I=1:1 Q:'$D(SRPROC(I)) S SRLN=SRLN+1 S:I=1 SR(SRLN)=" Other CPT Codes: "_$P(SRPROC(I),", ",2,99) S:I>1 SR(SRLN)=$J(SRPROC(I),$L(SRPROC(I))+19)
S SRLN=SRLN+1,SR(SRLN)=" Postop Diagnosis Code "_$$ICDSTR^SROICD(SRTN)_": "_SRPOST
S SRLN=SRLN+1,SR(SRLN)="",SRLN=SRLN+1
S I=0 F S I=$O(^TMP($J,"SRC",I)) Q:'I S SR(SRLN)=$G(^(I,0)),SRLN=SRLN+1
S I=0 F S I=$O(^SRO(136,SRTN,11,I)) Q:'I S XX=$G(^(I,0)) I $P(XX,"^") S XMY($P(XX,"^"))=""
S XMY(DUZ)=""
S X=$P($G(^SRO(133,SRSITE,7)),"^",2) I X S X=$$GET1^DIQ(3.8,X,.01) S:X]"" XMY("G."_X)=""
S XMSUB="Surgery Coding Issues" D NOW^%DTC S Y=% X ^DD("DD")
S XMTEXT="SR(" D ^XMD K XMTEXT,XMY,XMSUB,^TMP($J,"SRC")
W !!,"Transmitting message..."
END W @IOF D ^SRSKILL I $D(SRTN("KILL")) K SRTN
Q
ASK K DIR S DIR(0)="Y",DIR("A")="Do you want to alert the coders (Y/N)",DIR("B")="YES" D ^DIR S:'Y SRSOUT=1
Q
ERR ;The Coding Issue Alert cannot be created at this time
D EN^DDIOL("The information needed to send a code issue mail message is",,"!!")
D EN^DDIOL("not entered. Because the coding is not completed, no coder",,"!")
D EN^DDIOL("is identified. Also, there is no mail group identified in the",,"!")
D EN^DDIOL("CODE ISSUE MAIL GROUP site parameter.",,"!")
D EN^DDIOL("To send a coding issue message the case must have either the",,"!!")
D EN^DDIOL("coder or mail group identified.",,"!")
W ! K DIR S DIR(0)="FOA",DIR("A")="Press RETURN to continue " D ^DIR K DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROACOD 3602 printed Nov 22, 2024@17:50:10 Page 2
SROACOD ;BIR/SJA - ALERT CODERS OF POTENTIAL CODING ISSUES ;04/18/06
+1 ;;3.0;Surgery;**146,152,177,184**;24 Jun 93;Build 35
+2 IF '$DATA(SRTN)
KILL SRNEWOP
DO ^SROPS
if '$DATA(SRTN)
GOTO END
SET SRTN("KILL")=1
+3 NEW I,J,SRCPTP,SRLN,SRNODE0,SRPOST,SRTXT,SRSOUT,SRSUPCPT,X,XX,Y
+4 SET SRSOUT=0
SET SRSUPCPT=1
DO ^SROAUTL
START if SRSOUT
GOTO END
KILL SRAOTH
+1 DO HDR^SROAUTL
+2 WRITE !,"The following ""final"" codes have been entered for the case.",!!
+3 SET X=$PIECE($GET(^SRO(136,SRTN,0)),"^",2)
IF X
SET Y=$PIECE($$CPT^ICPTCOD(X),"^",2)
DO SSPRIN^SROCPT0
SET X=Y
+4 WRITE "Principal CPT Code: ",?30,$SELECT($LENGTH(X):X,1:"NOT ENTERED")
SET SRCPTP=X
+5 NEW SRPROC,K,SRL
+6 SET SRPROC(1)=""
SET SRL=60
SET K=1
DO OTH^SROUTLN
WRITE !,"Other CPT Codes: ",?30,$SELECT(SRPROC(1)="":"NOT ENTERED",1:"")
+7 FOR I=1:1
if '$DATA(SRPROC(I))
QUIT
if I=1
WRITE ?20,$PIECE(SRPROC(I),", ",2,99),!
if I'=1
WRITE ?20,SRPROC(I),!
+8 SET X=$PIECE($GET(^SRO(136,SRTN,0)),"^",3)
if X
SET X=$$ICD^SROICD(SRTN,X)
SET X=$PIECE(X,"^",2)_" "_$PIECE(X,"^",4)
+9 WRITE "Postop Diagnosis Code "_$$ICDSTR^SROICD(SRTN)_": ",?30,$SELECT(X'="":X,1:"NOT ENTERED"),!
SET SRPOST=X
+10 WRITE !!,"If you believe that the information coded is not correct and would like to",!,"alert the coders of the potential issue, enter a brief description of your",!,"concern below.",!
+11 DO ASK
if SRSOUT
GOTO END
+12 KILL ^TMP($JOB,"SRC")
ED WRITE !
SET DIC="^TMP($J,""SRC"","
SET DIWESUB="Coding Discrepancy Comments"
DO EN^DIWE
+1 IF '$DATA(^TMP($JOB,"SRC"))
WRITE !,"NOTE: You have exited the field without entering comments. ",!
+2 WRITE !
KILL DIR
SET DIR("A",1)="1. Transmit Message"
SET DIR("A",2)="2. Edit Text"
SET DIR("A",3)=""
SET DIR("A")="Select Number: "
+3 SET DIR(0)="NA^1:2"
SET DIR("B")=1
SET DIR("?",1)="Enter <RET> or '1' to Transmit Message,"
+4 SET DIR("?")="enter '2' to Edit the text or enter '^' to exit."
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO END
+5 IF Y=2
GOTO ED
MSG IF '$PIECE($GET(^SRO(136,SRTN,10)),"^")&('$PIECE($GET(^SRO(133,SRSITE,7)),"^",2))
DO ERR
GOTO END
+1 KILL SR,XMY
SET SRNODE0=$GET(^SRF(SRTN,0))
+2 SET SR(1)="Patient: "_$EXTRACT(VADM(1),1,20)_$JUSTIFY("",30-$LENGTH(VADM(1)))_" Case #: "_SRTN
+3 SET Y=$PIECE(SRNODE0,"^",9)
DO DD^%DT
SET SR(2)="Operation Date: "_Y
+4 SET SR(3)=""
+5 SET SR(4)="The following ""final"" codes have been entered for the case."
+6 SET DFN=$PIECE(SRNODE0,"^")
DO DEM^VADPT
+7 SET SR(5)=""
+8 SET SR(6)=" Principal CPT Code: "_SRCPTP
+9 SET SRLN=6
FOR I=1:1
if '$DATA(SRPROC(I))
QUIT
SET SRLN=SRLN+1
if I=1
SET SR(SRLN)=" Other CPT Codes: "_$PIECE(SRPROC(I),", ",2,99)
if I>1
SET SR(SRLN)=$JUSTIFY(SRPROC(I),$LENGTH(SRPROC(I))+19)
+10 SET SRLN=SRLN+1
SET SR(SRLN)=" Postop Diagnosis Code "_$$ICDSTR^SROICD(SRTN)_": "_SRPOST
+11 SET SRLN=SRLN+1
SET SR(SRLN)=""
SET SRLN=SRLN+1
+12 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,"SRC",I))
if 'I
QUIT
SET SR(SRLN)=$GET(^(I,0))
SET SRLN=SRLN+1
+13 SET I=0
FOR
SET I=$ORDER(^SRO(136,SRTN,11,I))
if 'I
QUIT
SET XX=$GET(^(I,0))
IF $PIECE(XX,"^")
SET XMY($PIECE(XX,"^"))=""
+14 SET XMY(DUZ)=""
+15 SET X=$PIECE($GET(^SRO(133,SRSITE,7)),"^",2)
IF X
SET X=$$GET1^DIQ(3.8,X,.01)
if X]""
SET XMY("G."_X)=""
+16 SET XMSUB="Surgery Coding Issues"
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+17 SET XMTEXT="SR("
DO ^XMD
KILL XMTEXT,XMY,XMSUB,^TMP($JOB,"SRC")
+18 WRITE !!,"Transmitting message..."
END WRITE @IOF
DO ^SRSKILL
IF $DATA(SRTN("KILL"))
KILL SRTN
+1 QUIT
ASK KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to alert the coders (Y/N)"
SET DIR("B")="YES"
DO ^DIR
if 'Y
SET SRSOUT=1
+1 QUIT
ERR ;The Coding Issue Alert cannot be created at this time
+1 DO EN^DDIOL("The information needed to send a code issue mail message is",,"!!")
+2 DO EN^DDIOL("not entered. Because the coding is not completed, no coder",,"!")
+3 DO EN^DDIOL("is identified. Also, there is no mail group identified in the",,"!")
+4 DO EN^DDIOL("CODE ISSUE MAIL GROUP site parameter.",,"!")
+5 DO EN^DDIOL("To send a coding issue message the case must have either the",,"!!")
+6 DO EN^DDIOL("coder or mail group identified.",,"!")
+7 WRITE !
KILL DIR
SET DIR(0)="FOA"
SET DIR("A")="Press RETURN to continue "
DO ^DIR
KILL DIR
+8 QUIT
