source: FOIAVistA/trunk/r/SURGERY-SR/SROACOD.m@ 1470

Last change on this file since 1470 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1SROACOD ;BIR/SJA - ALERT CODERS OF POTENTIAL CODING ISSUES ;04/18/06
2 ;;3.0; Surgery ;**146,152**;24 Jun 93
3 I '$D(SRTN) K SRNEWOP D ^SROPS G:'$D(SRTN) END S SRTN("KILL")=1
4 N I,J,SRCPTP,SRLN,SRNODE0,SRPOST,SRTXT,SRSOUT,SRSUPCPT,X,XX,Y
5 S SRSOUT=0,SRSUPCPT=1 D ^SROAUTL
6START G:SRSOUT END K SRAOTH
7 D HDR^SROAUTL
8 W !,"The following ""final"" codes have been entered for the case.",!!
9 S X=$P($G(^SRO(136,SRTN,0)),"^",2) I X S Y=$P($$CPT^ICPTCOD(X),"^",2) D SSPRIN^SROCPT0 S X=Y
10 W "Principal CPT Code: ",$S($L(X):X,1:"NOT ENTERED") S SRCPTP=X
11 N SRPROC,K,SRL
12 S SRPROC(1)="",SRL=60,K=1 D OTH^SROUTLN W !,"Other CPT Codes: "_$S(SRPROC(1)="":" NOT ENTERED",1:"")
13 F I=1:1 Q:'$D(SRPROC(I)) W:I=1 ?20,$P(SRPROC(I),", ",2,99),! W:I'=1 ?20,SRPROC(I),!
14 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)
15 W "Postop Diagnosis Code (ICD9): ",$S(X'="":X,1:"NOT ENTERED"),! S SRPOST=X
16 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.",!
17 D ASK G:SRSOUT END
18 K ^TMP($J,"SRC")
19ED W ! S DIC="^TMP($J,""SRC"",",DIWESUB="Coding Discrepancy Comments" D EN^DIWE
20 I '$D(^TMP($J,"SRC")) W !,"NOTE: You have exited the field without entering comments. ",!
21 W ! K DIR S DIR("A",1)="1. Transmit Message",DIR("A",2)="2. Edit Text",DIR("A",3)="",DIR("A")="Select Number: "
22 S DIR(0)="NA^1:2",DIR("B")=1,DIR("?",1)="Enter <RET> or '1' to Transmit Message,"
23 S DIR("?")="enter '2' to Edit the text or enter '^' to exit." D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) G END
24 I Y=2 G ED
25MSG I '$P($G(^SRO(136,SRTN,10)),"^")&('$P($G(^SRO(133,SRSITE,7)),"^",2)) D ERR G END
26 K SR,XMY S SRNODE0=$G(^SRF(SRTN,0))
27 S SR(1)="Patient: "_$E(VADM(1),1,20)_$J("",30-$L(VADM(1)))_" Case #: "_SRTN
28 S Y=$P(SRNODE0,"^",9) D DD^%DT S SR(2)="Operation Date: "_Y
29 S SR(3)=""
30 S SR(4)="The following ""final"" codes have been entered for the case."
31 S DFN=$P(SRNODE0,"^") D DEM^VADPT
32 S SR(5)=""
33 S SR(6)=" Principal CPT Code: "_SRCPTP
34 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)
35 S SRLN=SRLN+1,SR(SRLN)=" Postop Diagnosis Code (ICD9): "_SRPOST
36 S SRLN=SRLN+1,SR(SRLN)="",SRLN=SRLN+1
37 S I=0 F S I=$O(^TMP($J,"SRC",I)) Q:'I S SR(SRLN)=$G(^(I,0)),SRLN=SRLN+1
38 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,"^"))=""
39 S XMY(DUZ)=""
40 S X=$P($G(^SRO(133,SRSITE,7)),"^",2) I X S X=$$GET1^DIQ(3.8,X,.01) S:X]"" XMY("G."_X)=""
41 S XMSUB="Surgery Coding Issues" D NOW^%DTC S Y=% X ^DD("DD")
42 S XMTEXT="SR(" D ^XMD K XMTEXT,XMY,XMSUB,^TMP($J,"SRC")
43 W !!,"Transmitting message..."
44END W @IOF D ^SRSKILL I $D(SRTN("KILL")) K SRTN
45 Q
46ASK 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
47 Q
48ERR ;The Coding Issue Alert cannot be created at this time
49 D EN^DDIOL("The information needed to send a code issue mail message is",,"!!")
50 D EN^DDIOL("not entered. Because the coding is not completed, no coder",,"!")
51 D EN^DDIOL("is identified. Also, there is no mail group identified in the",,"!")
52 D EN^DDIOL("CODE ISSUE MAIL GROUP site parameter.",,"!")
53 D EN^DDIOL("To send a coding issue message the case must have either the",,"!!")
54 D EN^DDIOL("coder or mail group identified.",,"!")
55 W ! K DIR S DIR(0)="FOA",DIR("A")="Press RETURN to continue " D ^DIR K DIR
56 Q
Note: See TracBrowser for help on using the repository browser.