- SROACOD ;BIR/SJA - ALERT CODERS OF POTENTIAL CODING ISSUES ;04/18/06
- ;;3.0; Surgery ;**146,152**;24 Jun 93
- 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: ",$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: "_$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=$$ICDDX^ICDCODE(X,$P($G(^SRF(SRTN,0)),"^",9)),X=$P(X,"^",2)_" "_$P(X,"^",4)
- W "Postop Diagnosis Code (ICD9): ",$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 (ICD9): "_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
- SROACOD ;BIR/SJA - ALERT CODERS OF POTENTIAL CODING ISSUES ;04/18/06
- +1 ;;3.0; Surgery ;**146,152**;24 Jun 93
- +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: ",$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: "_$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=$$ICDDX^ICDCODE(X,$PIECE($GET(^SRF(SRTN,0)),"^",9))
- SET X=$PIECE(X,"^",2)_" "_$PIECE(X,"^",4)
- +9 WRITE "Postop Diagnosis Code (ICD9): ",$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 (ICD9): "_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
