source: FOIAVistA/tag/r/SURGERY-SR/SROCD4.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1SROCD4 ;BIR/ADM - MARK CASE CODING COMPLETE ;10/17/05
2 ;;3.0; Surgery ;**142**;24 Jun 93
3 ;
4 ; Reference to CL^SDCO21 supported by DBIA #406
5 ;
6 N SR,SRCHF,SRCL,SRDATA,SRDX,SRICD,SRK,SRMISS,SROTH,SRSDATE,SRTYPE
7 D CHF I SRCHF=1 D ASKCHF I SRCHFNO Q
8 S SR(0)=^SRO(136,SRTN,0) S SRSOUT=0,SREDIT=1
9 I $P(SR(0),"^",2)="" S SRMISS("PRINCIPAL PROCEDURE CODE")=""
10 I $P(SR(0),"^",3)="" S SRMISS("PRINCIPAL POSTOP DIAGNOSIS CODE")=""
11 S DFN=$P(^SRF(SRTN,0),"^"),SRSDATE=$P(^SRF(SRTN,0),"^",9) D CL^SDCO21(DFN,SRSDATE,,.SRCL) I $D(SRCL) D PSCEI
12 I '$O(^SRO(136,SRTN,2,0)) S SRMISS("PRINCIPAL ASSOCIATED DIAGNOSIS")=""
13 S SROTH=0 F S SROTH=$O(^SRO(136,SRTN,3,SROTH)) Q:'SROTH I '$O(^SRO(136,SRTN,3,SROTH,2,0)) S SRMISS("OTHER ASSOCIATED DIAGNOSIS")="" Q
14 S SROTH=0 F S SROTH=$O(^SRO(136,SRTN,4,SROTH)) Q:'SROTH I $D(SRCL) S SRDX=^SRO(136,SRTN,4,SROTH,0) D OSCEI
15 I $D(SRMISS) D MISS Q
16 I $P($G(^SRO(136,SRTN,10)),"^"),'$$CHNG^SROCD1 D Q
17 .I '$P(^SRF(SRTN,0),"^",15) D FILE Q
18 I '$P($G(^SRO(136,SRTN,10)),"^") D D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y Q
19 .W ! K DIR S DIR("A")="Is the coding of this case complete and ready to send to PCE",DIR("B")="NO",DIR(0)="Y"
20FILE D NOW^%DTC S SRNOW=$E(%,1,12) D
21 .K DA,DIE,DR S DA=SRTN,DIE=136,DR="10////1" D ^DIE K DA,DIE,DR
22 .K DD,DO S DIC="^SRO(136,SRTN,11,",DIC(0)="L",X=DUZ,DIC("DR")="1////"_SRNOW D FILE^DICN K DA,DD,DIC,DO,DR
23 .W !!,"Processing data to be sent to PCE..." D CHKIN I SRK D K SRK Q
24 ..W !!,"Information needed to send the case to PCE is missing. Use the PCE"
25 ..W !,"Filing Status Report to review missing information. The case will be"
26 ..W !,"sent to PCE upon completion of the missing information.",! D PAGE
27 .D START^SROPCEP ; send to PCE
28 .W !!,"Coding completed and sent to PCE.",! D PAGE
29 Q
30CHKIN ; check for items in file 130 required by PCE
31 N SR,SRAO,SRATT,SRCHK,SRCPT,SRCV,SRDATE,SRDEPC,SRDIAG,SRDXF,SREC,SRHNC,SRINOUT,SRIR,SRLOC,SRMST,SRNON,SRO,SRODIAG,SRPROV,SRRPROV,SRSC,SRUP,SRX
32 D UTIL^SROPCEP
33 Q
34CHF ; check diagnoses for CRIMEAN HEMORRHAGIC FEVER
35 N SRY,X,Y S SRY="",SRCHF=0
36 K DIC S DIC="^ICD9(",DIC(0)="XM",X="CHF" D ^DIC S:Y'=-1 SRY=+Y Q:'SRY
37 S Y=$$ICDDX^ICDCODE("065.0",$P(^SRF(SRTN,0),"^",9)) I $P(Y,"^")'=SRY Q
38 S SRICD=$P(Y,"^",2)_" "_$P(Y,"^",4),X=$P(^SRO(136,SRTN,0),"^",3) I X=SRY S SRCHF=1 Q
39 S Y=0 F S Y=$O(^SRO(136,SRTN,4,Y)) Q:'Y I $P(^SRO(136,SRTN,4,Y,0),"^")=SRY S SRCHF=1 Q
40 Q
41ASKCHF ; ask for confirmation of CRIMEAN HEMORRHAGIC FEVER diagnosis
42 K DIR S DIR("A",1)="",DIR(0)="Y",SRCHFNO=0
43 S DIR("A",2)="The ICD Diagnosis Code "_SRICD_" was entered as the"
44 S DIR("A",3)="Principal or Other Diagnosis. It is possible that you entered ""CHF"" and"
45 S DIR("A",4)="have the wrong code entered.",DIR("A",5)=""
46 S DIR("A",6)="Are you sure that you want to submit this case to PCE with the case"
47 S DIR("A")="coded using "_SRICD,DIR("B")="NO"
48 D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y S SRCHFNO=1
49 Q
50MISS W !!,"Coding of this surgical case is not complete.",!,"The following items are missing:",!
51 S SRDATA="" F S SRDATA=$O(SRMISS(SRDATA)) Q:SRDATA="" W ?5,SRDATA,!
52 W !,"This case cannot be sent to PCE until all missing information is supplied.",!
53PAGE K DIR S DIR(0)="FOA",DIR("A")="Press Enter/Return key to continue " D ^DIR K DIR
54 Q
55PSCEI S SRTYPE="PRINCIPAL"
56 I $D(SRCL(1)),$P(SR(0),"^",5)="" D SRSET Q
57 I $D(SRCL(2)),$P(SR(0),"^",6)="" D SRSET Q
58 I $D(SRCL(3)),$P(SR(0),"^",4)="" D SRSET Q
59 I $D(SRCL(4)),$P(SR(0),"^",7)="" D SRSET Q
60 I $D(SRCL(5)),$P(SR(0),"^",8)="" D SRSET Q
61 I $D(SRCL(6)),$P(SR(0),"^",9)="" D SRSET Q
62 I $D(SRCL(7)),$P(SR(0),"^",10)="" D SRSET
63 Q
64OSCEI S SRTYPE="OTHER DIAGNOSIS"
65 I $D(SRCL(1)),$P(SRDX,"^",3)="" D SRSET Q
66 I $D(SRCL(2)),$P(SRDX,"^",4)="" D SRSET Q
67 I $D(SRCL(3)),$P(SRDX,"^",2)="" D SRSET Q
68 I $D(SRCL(4)),$P(SRDX,"^",7)="" D SRSET Q
69 I $D(SRCL(5)),$P(SRDX,"^",5)="" D SRSET Q
70 I $D(SRCL(6)),$P(SRDX,"^",6)="" D SRSET Q
71 I $D(SRCL(7)),$P(SRDX,"^",8)="" D SRSET
72 Q
73SRSET S SRMISS(SRTYPE_" SC/EI")=""
74 Q
75CONV ; convert coding data from file 130 to file 136
76 I $O(^SRO(136,0)) D MES^XPDUTL("Conversion has already run.") Q
77 D NITE^SROPCE
78C2 N SRCT,SRD,SRODX,SRPDX,SRPP,SROP,SRP,SRTN
79 D MES^XPDUTL(" Converting coding data from file 130 to file 136...")
80 S (SRCT,SRTN)=0 F S SRTN=$O(^SRF(SRTN)) Q:'SRTN D
81 .I '$P($G(^SRF(SRTN,.2)),"^",12)&'$P($G(^SRF(SRTN,"NON")),"^",5) Q
82 .S SRPP=$P($G(^SRF(SRTN,"OP")),"^",2),(SROP,SRP)=0 F S SRP=$O(^SRF(SRTN,13,SRP)) Q:'SRP I $P($G(^SRF(SRTN,13,SRP,2)),"^") S SROP=1 Q
83 .S SRPDX=$P($G(^SRF(SRTN,34)),"^",2),(SRODX,SRD)=0 F S SRD=$O(^SRF(SRTN,15,SRD)) Q:'SRD I $P($G(^SRF(SRTN,15,SRD,0)),"^",3) S SRODX=1 Q
84 .I SRPP!SROP!SRPDX!SRODX D
85 ..Q:$D(^SRO(136,SRTN,0))
86 ..D ^SROCD1 S SRCT=SRCT+1 I '(SRCT#10000) D MES^XPDUTL(SRCT_" cases converted... ")
87 D MES^XPDUTL("Total cases converted: "_SRCT)
88 Q
89PRE ; pre-install entry
90 ; delete APCE x-refs
91 K DIE,DR,DIK,DA S DIK="^DD(130.16,3,1,",DA=1,DA(1)=3,DA(2)=130.16 D ^DIK
92 K DIK,DA S DIK="^DD(130.165,.01,1,",DA=2,DA(1)=.01,DA(2)=130.165 D ^DIK
93 K DIK,DA S DIK="^DD(130.18,.01,1,",DA=9,DA(1)=.01,DA(2)=130.18 D ^DIK
94 K DIK,DA S DIK="^DD(130.18,3,1,",DA=1,DA(1)=3,DA(2)=130.18 D ^DIK
95 K DIK,DA S DIK="^DD(130,27,1,",DA=1,DA(1)=27,DA(2)=130 D ^DIK
96 K DIK,DA S DIK="^DD(130.275,.01,1,",DA=1,DA(1)=.01,DA(2)=130.275 D ^DIK
97 K DIK,DA S DIK="^DD(130,32.5,1,",DA=1,DA(1)=32.5,DA(2)=130 D ^DIK
98 K DIK,DA S DIK="^DD(130,66,1,",DA=1,DA(1)=66,DA(2)=130 D ^DIK K DIK,DA
99 Q
Note: See TracBrowser for help on using the repository browser.