SROCD4 ;BIR/ADM - MARK CASE CODING COMPLETE ;10/17/05
;;3.0; Surgery ;**142**;24 Jun 93
;
; Reference to CL^SDCO21 supported by DBIA #406
;
N SR,SRCHF,SRCL,SRDATA,SRDX,SRICD,SRK,SRMISS,SROTH,SRSDATE,SRTYPE
D CHF I SRCHF=1 D ASKCHF I SRCHFNO Q
S SR(0)=^SRO(136,SRTN,0) S SRSOUT=0,SREDIT=1
I $P(SR(0),"^",2)="" S SRMISS("PRINCIPAL PROCEDURE CODE")=""
I $P(SR(0),"^",3)="" S SRMISS("PRINCIPAL POSTOP DIAGNOSIS CODE")=""
S DFN=$P(^SRF(SRTN,0),"^"),SRSDATE=$P(^SRF(SRTN,0),"^",9) D CL^SDCO21(DFN,SRSDATE,,.SRCL) I $D(SRCL) D PSCEI
I '$O(^SRO(136,SRTN,2,0)) S SRMISS("PRINCIPAL ASSOCIATED DIAGNOSIS")=""
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
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
I $D(SRMISS) D MISS Q
I $P($G(^SRO(136,SRTN,10)),"^"),'$$CHNG^SROCD1 D Q
.I '$P(^SRF(SRTN,0),"^",15) D FILE Q
I '$P($G(^SRO(136,SRTN,10)),"^") D D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y Q
.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"
FILE D NOW^%DTC S SRNOW=$E(%,1,12) D
.K DA,DIE,DR S DA=SRTN,DIE=136,DR="10////1" D ^DIE K DA,DIE,DR
.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
.W !!,"Processing data to be sent to PCE..." D CHKIN I SRK D K SRK Q
..W !!,"Information needed to send the case to PCE is missing. Use the PCE"
..W !,"Filing Status Report to review missing information. The case will be"
..W !,"sent to PCE upon completion of the missing information.",! D PAGE
.D START^SROPCEP ; send to PCE
.W !!,"Coding completed and sent to PCE.",! D PAGE
Q
CHKIN ; check for items in file 130 required by PCE
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
D UTIL^SROPCEP
Q
CHF ; check diagnoses for CRIMEAN HEMORRHAGIC FEVER
N SRY,X,Y S SRY="",SRCHF=0
K DIC S DIC="^ICD9(",DIC(0)="XM",X="CHF" D ^DIC S:Y'=-1 SRY=+Y Q:'SRY
S Y=$$ICDDX^ICDCODE("065.0",$P(^SRF(SRTN,0),"^",9)) I $P(Y,"^")'=SRY Q
S SRICD=$P(Y,"^",2)_" "_$P(Y,"^",4),X=$P(^SRO(136,SRTN,0),"^",3) I X=SRY S SRCHF=1 Q
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
Q
ASKCHF ; ask for confirmation of CRIMEAN HEMORRHAGIC FEVER diagnosis
K DIR S DIR("A",1)="",DIR(0)="Y",SRCHFNO=0
S DIR("A",2)="The ICD Diagnosis Code "_SRICD_" was entered as the"
S DIR("A",3)="Principal or Other Diagnosis. It is possible that you entered ""CHF"" and"
S DIR("A",4)="have the wrong code entered.",DIR("A",5)=""
S DIR("A",6)="Are you sure that you want to submit this case to PCE with the case"
S DIR("A")="coded using "_SRICD,DIR("B")="NO"
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y S SRCHFNO=1
Q
MISS W !!,"Coding of this surgical case is not complete.",!,"The following items are missing:",!
S SRDATA="" F S SRDATA=$O(SRMISS(SRDATA)) Q:SRDATA="" W ?5,SRDATA,!
W !,"This case cannot be sent to PCE until all missing information is supplied.",!
PAGE K DIR S DIR(0)="FOA",DIR("A")="Press Enter/Return key to continue " D ^DIR K DIR
Q
PSCEI S SRTYPE="PRINCIPAL"
I $D(SRCL(1)),$P(SR(0),"^",5)="" D SRSET Q
I $D(SRCL(2)),$P(SR(0),"^",6)="" D SRSET Q
I $D(SRCL(3)),$P(SR(0),"^",4)="" D SRSET Q
I $D(SRCL(4)),$P(SR(0),"^",7)="" D SRSET Q
I $D(SRCL(5)),$P(SR(0),"^",8)="" D SRSET Q
I $D(SRCL(6)),$P(SR(0),"^",9)="" D SRSET Q
I $D(SRCL(7)),$P(SR(0),"^",10)="" D SRSET
Q
OSCEI S SRTYPE="OTHER DIAGNOSIS"
I $D(SRCL(1)),$P(SRDX,"^",3)="" D SRSET Q
I $D(SRCL(2)),$P(SRDX,"^",4)="" D SRSET Q
I $D(SRCL(3)),$P(SRDX,"^",2)="" D SRSET Q
I $D(SRCL(4)),$P(SRDX,"^",7)="" D SRSET Q
I $D(SRCL(5)),$P(SRDX,"^",5)="" D SRSET Q
I $D(SRCL(6)),$P(SRDX,"^",6)="" D SRSET Q
I $D(SRCL(7)),$P(SRDX,"^",8)="" D SRSET
Q
SRSET S SRMISS(SRTYPE_" SC/EI")=""
Q
CONV ; convert coding data from file 130 to file 136
I $O(^SRO(136,0)) D MES^XPDUTL("Conversion has already run.") Q
D NITE^SROPCE
C2 N SRCT,SRD,SRODX,SRPDX,SRPP,SROP,SRP,SRTN
D MES^XPDUTL(" Converting coding data from file 130 to file 136...")
S (SRCT,SRTN)=0 F S SRTN=$O(^SRF(SRTN)) Q:'SRTN D
.I '$P($G(^SRF(SRTN,.2)),"^",12)&'$P($G(^SRF(SRTN,"NON")),"^",5) Q
.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
.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
.I SRPP!SROP!SRPDX!SRODX D
..Q:$D(^SRO(136,SRTN,0))
..D ^SROCD1 S SRCT=SRCT+1 I '(SRCT#10000) D MES^XPDUTL(SRCT_" cases converted... ")
D MES^XPDUTL("Total cases converted: "_SRCT)
Q
PRE ; pre-install entry
; delete APCE x-refs
K DIE,DR,DIK,DA S DIK="^DD(130.16,3,1,",DA=1,DA(1)=3,DA(2)=130.16 D ^DIK
K DIK,DA S DIK="^DD(130.165,.01,1,",DA=2,DA(1)=.01,DA(2)=130.165 D ^DIK
K DIK,DA S DIK="^DD(130.18,.01,1,",DA=9,DA(1)=.01,DA(2)=130.18 D ^DIK
K DIK,DA S DIK="^DD(130.18,3,1,",DA=1,DA(1)=3,DA(2)=130.18 D ^DIK
K DIK,DA S DIK="^DD(130,27,1,",DA=1,DA(1)=27,DA(2)=130 D ^DIK
K DIK,DA S DIK="^DD(130.275,.01,1,",DA=1,DA(1)=.01,DA(2)=130.275 D ^DIK
K DIK,DA S DIK="^DD(130,32.5,1,",DA=1,DA(1)=32.5,DA(2)=130 D ^DIK
K DIK,DA S DIK="^DD(130,66,1,",DA=1,DA(1)=66,DA(2)=130 D ^DIK K DIK,DA
Q
SROCD4 ;BIR/ADM - MARK CASE CODING COMPLETE ;10/17/05
+1 ;;3.0; Surgery ;**142**;24 Jun 93
+2 ;
+3 ; Reference to CL^SDCO21 supported by DBIA #406
+4 ;
+5 NEW SR,SRCHF,SRCL,SRDATA,SRDX,SRICD,SRK,SRMISS,SROTH,SRSDATE,SRTYPE
+6 DO CHF
IF SRCHF=1
DO ASKCHF
IF SRCHFNO
QUIT
+7 SET SR(0)=^SRO(136,SRTN,0)
SET SRSOUT=0
SET SREDIT=1
+8 IF $PIECE(SR(0),"^",2)=""
SET SRMISS("PRINCIPAL PROCEDURE CODE")=""
+9 IF $PIECE(SR(0),"^",3)=""
SET SRMISS("PRINCIPAL POSTOP DIAGNOSIS CODE")=""
+10 SET DFN=$PIECE(^SRF(SRTN,0),"^")
SET SRSDATE=$PIECE(^SRF(SRTN,0),"^",9)
DO CL^SDCO21(DFN,SRSDATE,,.SRCL)
IF $DATA(SRCL)
DO PSCEI
+11 IF '$ORDER(^SRO(136,SRTN,2,0))
SET SRMISS("PRINCIPAL ASSOCIATED DIAGNOSIS")=""
+12 SET SROTH=0
FOR
SET SROTH=$ORDER(^SRO(136,SRTN,3,SROTH))
IF 'SROTH
QUIT
IF '$ORDER(^SRO(136,SRTN,3,SROTH,2,0))
SET SRMISS("OTHER ASSOCIATED DIAGNOSIS")=""
QUIT
+13 SET SROTH=0
FOR
SET SROTH=$ORDER(^SRO(136,SRTN,4,SROTH))
IF 'SROTH
QUIT
IF $DATA(SRCL)
SET SRDX=^SRO(136,SRTN,4,SROTH,0)
DO OSCEI
+14 IF $DATA(SRMISS)
DO MISS
QUIT
+15 IF $PIECE($GET(^SRO(136,SRTN,10)),"^")
IF '$$CHNG^SROCD1
Begin DoDot:1
+16 IF '$PIECE(^SRF(SRTN,0),"^",15)
DO FILE
QUIT
End DoDot:1
QUIT
+17 IF '$PIECE($GET(^SRO(136,SRTN,10)),"^")
Begin DoDot:1
+18 WRITE !
KILL DIR
SET DIR("A")="Is the coding of this case complete and ready to send to PCE"
SET DIR("B")="NO"
SET DIR(0)="Y"
End DoDot:1
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)!'Y
QUIT
FILE DO NOW^%DTC
SET SRNOW=$EXTRACT(%,1,12)
Begin DoDot:1
+1 KILL DA,DIE,DR
SET DA=SRTN
SET DIE=136
SET DR="10////1"
DO ^DIE
KILL DA,DIE,DR
+2 KILL DD,DO
SET DIC="^SRO(136,SRTN,11,"
SET DIC(0)="L"
SET X=DUZ
SET DIC("DR")="1////"_SRNOW
DO FILE^DICN
KILL DA,DD,DIC,DO,DR
+3 WRITE !!,"Processing data to be sent to PCE..."
DO CHKIN
IF SRK
Begin DoDot:2
+4 WRITE !!,"Information needed to send the case to PCE is missing. Use the PCE"
+5 WRITE !,"Filing Status Report to review missing information. The case will be"
+6 WRITE !,"sent to PCE upon completion of the missing information.",!
DO PAGE
End DoDot:2
KILL SRK
QUIT
+7 ; send to PCE
DO START^SROPCEP
+8 WRITE !!,"Coding completed and sent to PCE.",!
DO PAGE
End DoDot:1
+9 QUIT
CHKIN ; check for items in file 130 required by PCE
+1 NEW SR,SRAO,SRATT,SRCHK,SRCPT,SRCV,SRDATE,SRDEPC,SRDIAG,SRDXF,SREC,SRHNC,SRINOUT,SRIR,SRLOC,SRMST,SRNON,SRO,SRODIAG,SRPROV,SRRPROV,SRSC,SRUP,SRX
+2 DO UTIL^SROPCEP
+3 QUIT
CHF ; check diagnoses for CRIMEAN HEMORRHAGIC FEVER
+1 NEW SRY,X,Y
SET SRY=""
SET SRCHF=0
+2 KILL DIC
SET DIC="^ICD9("
SET DIC(0)="XM"
SET X="CHF"
DO ^DIC
IF Y'=-1
SET SRY=+Y
IF 'SRY
QUIT
+3 SET Y=$$ICDDX^ICDCODE("065.0",$PIECE(^SRF(SRTN,0),"^",9))
IF $PIECE(Y,"^")'=SRY
QUIT
+4 SET SRICD=$PIECE(Y,"^",2)_" "_$PIECE(Y,"^",4)
SET X=$PIECE(^SRO(136,SRTN,0),"^",3)
IF X=SRY
SET SRCHF=1
QUIT
+5 SET Y=0
FOR
SET Y=$ORDER(^SRO(136,SRTN,4,Y))
IF 'Y
QUIT
IF $PIECE(^SRO(136,SRTN,4,Y,0),"^")=SRY
SET SRCHF=1
QUIT
+6 QUIT
ASKCHF ; ask for confirmation of CRIMEAN HEMORRHAGIC FEVER diagnosis
+1 KILL DIR
SET DIR("A",1)=""
SET DIR(0)="Y"
SET SRCHFNO=0
+2 SET DIR("A",2)="The ICD Diagnosis Code "_SRICD_" was entered as the"
+3 SET DIR("A",3)="Principal or Other Diagnosis. It is possible that you entered ""CHF"" and"
+4 SET DIR("A",4)="have the wrong code entered."
SET DIR("A",5)=""
+5 SET DIR("A",6)="Are you sure that you want to submit this case to PCE with the case"
+6 SET DIR("A")="coded using "_SRICD
SET DIR("B")="NO"
+7 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)!'Y
SET SRCHFNO=1
+8 QUIT
MISS WRITE !!,"Coding of this surgical case is not complete.",!,"The following items are missing:",!
+1 SET SRDATA=""
FOR
SET SRDATA=$ORDER(SRMISS(SRDATA))
IF SRDATA=""
QUIT
WRITE ?5,SRDATA,!
+2 WRITE !,"This case cannot be sent to PCE until all missing information is supplied.",!
PAGE KILL DIR
SET DIR(0)="FOA"
SET DIR("A")="Press Enter/Return key to continue "
DO ^DIR
KILL DIR
+1 QUIT
PSCEI SET SRTYPE="PRINCIPAL"
+1 IF $DATA(SRCL(1))
IF $PIECE(SR(0),"^",5)=""
DO SRSET
QUIT
+2 IF $DATA(SRCL(2))
IF $PIECE(SR(0),"^",6)=""
DO SRSET
QUIT
+3 IF $DATA(SRCL(3))
IF $PIECE(SR(0),"^",4)=""
DO SRSET
QUIT
+4 IF $DATA(SRCL(4))
IF $PIECE(SR(0),"^",7)=""
DO SRSET
QUIT
+5 IF $DATA(SRCL(5))
IF $PIECE(SR(0),"^",8)=""
DO SRSET
QUIT
+6 IF $DATA(SRCL(6))
IF $PIECE(SR(0),"^",9)=""
DO SRSET
QUIT
+7 IF $DATA(SRCL(7))
IF $PIECE(SR(0),"^",10)=""
DO SRSET
+8 QUIT
OSCEI SET SRTYPE="OTHER DIAGNOSIS"
+1 IF $DATA(SRCL(1))
IF $PIECE(SRDX,"^",3)=""
DO SRSET
QUIT
+2 IF $DATA(SRCL(2))
IF $PIECE(SRDX,"^",4)=""
DO SRSET
QUIT
+3 IF $DATA(SRCL(3))
IF $PIECE(SRDX,"^",2)=""
DO SRSET
QUIT
+4 IF $DATA(SRCL(4))
IF $PIECE(SRDX,"^",7)=""
DO SRSET
QUIT
+5 IF $DATA(SRCL(5))
IF $PIECE(SRDX,"^",5)=""
DO SRSET
QUIT
+6 IF $DATA(SRCL(6))
IF $PIECE(SRDX,"^",6)=""
DO SRSET
QUIT
+7 IF $DATA(SRCL(7))
IF $PIECE(SRDX,"^",8)=""
DO SRSET
+8 QUIT
SRSET SET SRMISS(SRTYPE_" SC/EI")=""
+1 QUIT
CONV ; convert coding data from file 130 to file 136
+1 IF $ORDER(^SRO(136,0))
DO MES^XPDUTL("Conversion has already run.")
QUIT
+2 DO NITE^SROPCE
C2 NEW SRCT,SRD,SRODX,SRPDX,SRPP,SROP,SRP,SRTN
+1 DO MES^XPDUTL(" Converting coding data from file 130 to file 136...")
+2 SET (SRCT,SRTN)=0
FOR
SET SRTN=$ORDER(^SRF(SRTN))
IF 'SRTN
QUIT
Begin DoDot:1
+3 IF '$PIECE($GET(^SRF(SRTN,.2)),"^",12)&'$PIECE($GET(^SRF(SRTN,"NON")),"^",5)
QUIT
+4 SET SRPP=$PIECE($GET(^SRF(SRTN,"OP")),"^",2)
SET (SROP,SRP)=0
FOR
SET SRP=$ORDER(^SRF(SRTN,13,SRP))
IF 'SRP
QUIT
IF $PIECE($GET(^SRF(SRTN,13,SRP,2)),"^")
SET SROP=1
QUIT
+5 SET SRPDX=$PIECE($GET(^SRF(SRTN,34)),"^",2)
SET (SRODX,SRD)=0
FOR
SET SRD=$ORDER(^SRF(SRTN,15,SRD))
IF 'SRD
QUIT
IF $PIECE($GET(^SRF(SRTN,15,SRD,0)),"^",3)
SET SRODX=1
QUIT
+6 IF SRPP!SROP!SRPDX!SRODX
Begin DoDot:2
+7 IF $DATA(^SRO(136,SRTN,0))
QUIT
+8 DO ^SROCD1
SET SRCT=SRCT+1
IF '(SRCT#10000)
DO MES^XPDUTL(SRCT_" cases converted... ")
End DoDot:2
End DoDot:1
+9 DO MES^XPDUTL("Total cases converted: "_SRCT)
+10 QUIT
PRE ; pre-install entry
+1 ; delete APCE x-refs
+2 KILL DIE,DR,DIK,DA
SET DIK="^DD(130.16,3,1,"
SET DA=1
SET DA(1)=3
SET DA(2)=130.16
DO ^DIK
+3 KILL DIK,DA
SET DIK="^DD(130.165,.01,1,"
SET DA=2
SET DA(1)=.01
SET DA(2)=130.165
DO ^DIK
+4 KILL DIK,DA
SET DIK="^DD(130.18,.01,1,"
SET DA=9
SET DA(1)=.01
SET DA(2)=130.18
DO ^DIK
+5 KILL DIK,DA
SET DIK="^DD(130.18,3,1,"
SET DA=1
SET DA(1)=3
SET DA(2)=130.18
DO ^DIK
+6 KILL DIK,DA
SET DIK="^DD(130,27,1,"
SET DA=1
SET DA(1)=27
SET DA(2)=130
DO ^DIK
+7 KILL DIK,DA
SET DIK="^DD(130.275,.01,1,"
SET DA=1
SET DA(1)=.01
SET DA(2)=130.275
DO ^DIK
+8 KILL DIK,DA
SET DIK="^DD(130,32.5,1,"
SET DA=1
SET DA(1)=32.5
SET DA(2)=130
DO ^DIK
+9 KILL DIK,DA
SET DIK="^DD(130,66,1,"
SET DA=1
SET DA(1)=66
SET DA(2)=130
DO ^DIK
KILL DIK,DA
+10 QUIT
