SROCVER ;BIR/SJA - CODE SET VERSIONING UTILITY ; [ 01/29/03 08:18 AM ]
;;3.0; Surgery ;**116**;24 Jun 93
;
;Reference to $$ICDDX^ICDCODE supported by DBIA #3990
;Reference to $$CPT^ICPTCOD supported by DBIA #1995
;Reference to ^TMP("CSLSUR1" supported by DBIA #3498
;
VALIDAT N ATTD,SRBB,SRCC,DLN,SRII,SRJJ,SLN,OCOD,SRAA,SRCODE,SRDATE,SRMOD,SRND0,SRND1,SRND34,SRNON,SRJ,SROP,SRPD,SRT,SRY,SRX,SRX1,SRYY,XMY,Y
K ^TMP("SRCVER",$J) S $P(DLN,"-",78)=""
S SRTN=$S($D(SRTN):SRTN,1:DA),SRND0=$G(^SRF(SRTN,0)),SROP=$G(^SRF(SRTN,"OP")),SRND1=$G(^SRF(SRTN,.1)),SRNON=$G(^SRF(SRTN,"NON"))
S SRPD=$S($D(^SRF(SRTN,"NON")):$P(SRNON,"^",6),1:$P(SRND1,"^",4)),ATTD=$S($D(^SRF(SRTN,"NON")):$P(SRNON,"^",7),1:$P(SRND1,"^",13)),SRND34=$G(^SRF(SRTN,34))
S SRDATE=$S($P(SRND0,"^",9):$P(SRND0,"^",9),1:DT)
;
S SRCODE=$P(SROP,"^",2) I SRCODE S SRT=$$CPT^ICPTCOD(SRCODE,SRDATE) I $P(SRT,"^",7)=0 S ^TMP("SRCVER",$J,"1;!;PRINCIPAL CPT CODE",$P(SRT,"^",2))=SRCODE D
.S (SRJJ,SRII)=0 F S SRII=$O(^SRF(SRTN,"OPMOD",SRII)) Q:'SRII S SRMOD="" S (Y,SRT)=$P($G(^SRF(SRTN,"OPMOD",SRII,0)),"^") D DISPLAY^SROMOD S SRMOD=$S($G(SRMOD):SRMOD_","_Y,1:Y) D
..S ^TMP("SRCVER",$J,"1_1;; CPT MODIFIER",SRMOD)=SRT_"^"_SRII
;
S (SRT,SRAA)=0 F S SRAA=$O(^SRF(SRTN,13,SRAA)) Q:'SRAA S OCOD=+$G(^(SRAA,2)) I OCOD S SRT=$$CPT^ICPTCOD(OCOD,SRDATE) I $P(SRT,"^",7)=0 S ^TMP("SRCVER",$J,"2;!;OTHER PROCEDURE CPT CODE",$P(SRT,"^",2))=OCOD_"^"_SRAA D
.S SRBB=0 F S SRBB=$O(^SRF(SRTN,13,SRAA,"MOD",SRBB)) Q:'SRBB S SRMOD="" S (SRT,Y)=$P($G(^SRF(SRTN,13,SRAA,"MOD",SRBB,0)),"^") D DISPLAY^SROMOD S SRMOD=$S($G(SRMOD):SRMOD_","_Y,1:Y) D
..S ^TMP("SRCVER",$J,"2_1;; CPT MODIFIER",SRMOD)=$P(SRT,"^")_"^"_SRAA
;
I $P(SRND34,"^",2)'="" S SRT=$$ICDDX^ICDCODE($P(SRND34,"^",2),SRDATE) I $P(SRT,"^",10)=0 S ^TMP("SRCVER",$J,"3;!;PRIN DIAGNOSIS CODE",$P(SRT,"^",2))=$P(SRND34,"^",2)
;
S SRAA=0 F S SRAA=$O(^SRF(SRTN,14,SRAA)) Q:'SRAA S OCOD=$P(^SRF(SRTN,14,SRAA,0),"^",3) I OCOD S SRT=$$ICDDX^ICDCODE(OCOD,SRDATE) I $P(SRT,"^",10)=0 S ^TMP("SRCVER",$J,"4;!;OTHER PREOP DIAGNOSIS",$P(SRT,"^",2))=OCOD_"^"_SRAA
;
DISP Q:'$D(^TMP("SRCVER",$J))
W !!,DLN
D EN^DDIOL("The following codes are no longer active and will be deleted for case #:"_SRTN,,"!")
S SRAA="" F S SRAA=$O(^TMP("SRCVER",$J,SRAA)) Q:SRAA="" W:SRAA["!" ! S (SRBB,SRCC)="" F S SRBB=$O(^TMP("SRCVER",$J,SRAA,SRBB)) Q:SRBB="" S SRCC=SRCC+1 D
.W:SRCC=1 !,?10,$P(SRAA,";",3)_": ",?40,SRBB W:SRCC>1 !,?40,SRBB
D EN^DDIOL("New active codes must be re-entered. A MailMan message will be sent to",,"!!")
D EN^DDIOL("the "_$S(SRNON'="":"provider and attending provider",1:"surgeon and attending surgeon")_" of record and to the user who edited",,"!")
D EN^DDIOL("the record with case details for follow-up.",,"!")
W !!,DLN
W !!,"Press RETURN to continue " R SRX:DTIME
D SENDMSG
Q
SENDMSG ;Send mail message when check is complete.
Q:'$D(^TMP("SRCVER",$J))
K SR,XMY S XMDUZ="SURGERY PACKAGE",XMSUB="ICD-9 OR CPT CODE DELETION",XMY(DUZ)="",SLN=0 D NOW^%DTC S Y=% X ^DD("DD")
F SRJJ=SRPD,ATTD,DUZ S:$G(SRJJ) XMY(SRJJ)=""
S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT
S SR(1)="Patient: "_$E(VADM(1),1,20)_$J("",30-$L(VADM(1)))_" Case #: "_SRTN
S Y=SRDATE D DD^%DT
S SR(2)=$S(SRNON'="":"Procedure Date: ",1:"Operation Date: ")_Y_" "_$P(SROP,"^"),SR(3)=""
S SR(5)="The following codes are no longer active and were deleted for this"
S SR(6)="case when the "_$S(SRNON'="":"Time Procedure Began",1:"Time Patient in OR")_" was entered."
S SR(7)="",SLN=8
S SRX=$J("",8),SRX1=$J("",40)
;
PCPT S SRAA=0,SRAA=$O(^TMP("SRCVER",$J,"1;!;PRINCIPAL CPT CODE",SRAA)) I SRAA S SR(SLN)=SRX_"PRINCIPAL CPT CODE: "_SRAA D
.K SRY S SRY(130,SRTN_",",27)="@" D FILE^DIE("","SRY")
.S SRMOD="",SRJJ=0 F S SRMOD=$O(^TMP("SRCVER",$J,"1_1;; CPT MODIFIER",SRMOD)) Q:SRMOD="" D
..S SRJJ=SRJJ+1,SLN=SLN+1 S:SRJJ=1 SR(SLN)=SRX_" CPT MODIFIER:"_$J("",14)_SRMOD S:SRJJ>1 SR(SLN)=$J("",36)_SRMOD
..K SRY S SRY(130,SRTN_",",28)="@" D FILE^DIE("","SRY")
S SLN=SLN+1,SR(SLN)=""
;
OCPT S SRAA=0,SLN=SLN+1 F S SRAA=$O(^TMP("SRCVER",$J,"2;!;OTHER PROCEDURE CPT CODE",SRAA)) Q:'SRAA S SR(SLN)=SRX_"OTHER PROCEDURE CPT CODE: "_SRAA,SRJ=$P($G(^(SRAA)),"^",2) D
.K SRY S SRY(130.16,SRJ_","_SRTN_",",3)="@" D FILE^DIE("","SRY")
.S SRMOD="",SRJJ=0 F S SRMOD=$O(^TMP("SRCVER",$J,"2_1;; CPT MODIFIER",SRMOD)) Q:SRMOD="" S SRJ=$G(^(SRMOD)) D
..S SRJJ=SRJJ+1,SLN=SLN+1 S:SRJJ=1 SR(SLN)=SRX_" CPT MODIFIER:"_$J("",14)_SRMOD S:SRJJ>1 SR(SLN)=$J("",36)_SRMOD
..K SRY S SRY(130.16,SRJ_","_SRTN_",",4)="@" D FILE^DIE("","SRY")
;
PD S SRAA=0,SLN=SLN+1,SRAA=$O(^TMP("SRCVER",$J,"3;!;PRIN DIAGNOSIS CODE",SRAA)) I SRAA S SR(SLN)=SRX_"PRIN DIAGNOSIS CODE:"_SRX_SRAA K SRY S SRY(130,SRTN_",",66)="@" D FILE^DIE("","SRY")
;
OPD S (SRJJ,SRAA)=0 F S SRAA=$O(^TMP("SRCVER",$J,"4;!;OTHER PREOP DIAGNOSIS",SRAA)) Q:'SRAA S SLN=SLN+1,SRJJ=SRJJ+1 S SRYY=$P($G(^(SRAA)),"^",2) D
.S:SRJJ=1 SR(SLN)=SRX_"OTHER PREOP DIAGNOSIS:"_$J("",6)_SRAA S:SRJJ>1 SR(SLN)=$J("",36)_SRAA
.K SRY S SRY(130.17,SRYY_","_SRTN_",",3)="@" D FILE^DIE("","SRY")
S (SR(SLN+1),SR(SLN+2))=""
S SR(SLN+3)="New active codes must be re-entered."
S XMTEXT="SR(" D ^XMD
;
CFLS ;This line of code to update Surgery-CoreFLS changes
Q:'$D(^TMP("CSLSUR1",$J))
S SRSITE=$S($D(SRSITE):SRSITE,1:$$SITE^SROUTL0(SRTN))
S SROERR=SRTN D ^SROERR0
Q
SROCVER ;BIR/SJA - CODE SET VERSIONING UTILITY ; [ 01/29/03 08:18 AM ]
+1 ;;3.0; Surgery ;**116**;24 Jun 93
+2 ;
+3 ;Reference to $$ICDDX^ICDCODE supported by DBIA #3990
+4 ;Reference to $$CPT^ICPTCOD supported by DBIA #1995
+5 ;Reference to ^TMP("CSLSUR1" supported by DBIA #3498
+6 ;
VALIDAT NEW ATTD,SRBB,SRCC,DLN,SRII,SRJJ,SLN,OCOD,SRAA,SRCODE,SRDATE,SRMOD,SRND0,SRND1,SRND34,SRNON,SRJ,SROP,SRPD,SRT,SRY,SRX,SRX1,SRYY,XMY,Y
+1 KILL ^TMP("SRCVER",$JOB)
SET $PIECE(DLN,"-",78)=""
+2 SET SRTN=$SELECT($DATA(SRTN):SRTN,1:DA)
SET SRND0=$GET(^SRF(SRTN,0))
SET SROP=$GET(^SRF(SRTN,"OP"))
SET SRND1=$GET(^SRF(SRTN,.1))
SET SRNON=$GET(^SRF(SRTN,"NON"))
+3 SET SRPD=$SELECT($DATA(^SRF(SRTN,"NON")):$PIECE(SRNON,"^",6),1:$PIECE(SRND1,"^",4))
SET ATTD=$SELECT($DATA(^SRF(SRTN,"NON")):$PIECE(SRNON,"^",7),1:$PIECE(SRND1,"^",13))
SET SRND34=$GET(^SRF(SRTN,34))
+4 SET SRDATE=$SELECT($PIECE(SRND0,"^",9):$PIECE(SRND0,"^",9),1:DT)
+5 ;
+6 SET SRCODE=$PIECE(SROP,"^",2)
IF SRCODE
SET SRT=$$CPT^ICPTCOD(SRCODE,SRDATE)
IF $PIECE(SRT,"^",7)=0
SET ^TMP("SRCVER",$JOB,"1;!;PRINCIPAL CPT CODE",$PIECE(SRT,"^",2))=SRCODE
Begin DoDot:1
+7 SET (SRJJ,SRII)=0
FOR
SET SRII=$ORDER(^SRF(SRTN,"OPMOD",SRII))
IF 'SRII
QUIT
SET SRMOD=""
SET (Y,SRT)=$PIECE($GET(^SRF(SRTN,"OPMOD",SRII,0)),"^")
DO DISPLAY^SROMOD
SET SRMOD=$SELECT($GET(SRMOD):SRMOD_","_Y,1:Y)
Begin DoDot:2
+8 SET ^TMP("SRCVER",$JOB,"1_1;; CPT MODIFIER",SRMOD)=SRT_"^"_SRII
End DoDot:2
End DoDot:1
+9 ;
+10 SET (SRT,SRAA)=0
FOR
SET SRAA=$ORDER(^SRF(SRTN,13,SRAA))
IF 'SRAA
QUIT
SET OCOD=+$GET(^(SRAA,2))
IF OCOD
SET SRT=$$CPT^ICPTCOD(OCOD,SRDATE)
IF $PIECE(SRT,"^",7)=0
SET ^TMP("SRCVER",$JOB,"2;!;OTHER PROCEDURE CPT CODE",$PIECE(SRT,"^",2))=OCOD_"^"_SRAA
Begin DoDot:1
+11 SET SRBB=0
FOR
SET SRBB=$ORDER(^SRF(SRTN,13,SRAA,"MOD",SRBB))
IF 'SRBB
QUIT
SET SRMOD=""
SET (SRT,Y)=$PIECE($GET(^SRF(SRTN,13,SRAA,"MOD",SRBB,0)),"^")
DO DISPLAY^SROMOD
SET SRMOD=$SELECT($GET(SRMOD):SRMOD_","_Y,1:Y)
Begin DoDot:2
+12 SET ^TMP("SRCVER",$JOB,"2_1;; CPT MODIFIER",SRMOD)=$PIECE(SRT,"^")_"^"_SRAA
End DoDot:2
End DoDot:1
+13 ;
+14 IF $PIECE(SRND34,"^",2)'=""
SET SRT=$$ICDDX^ICDCODE($PIECE(SRND34,"^",2),SRDATE)
IF $PIECE(SRT,"^",10)=0
SET ^TMP("SRCVER",$JOB,"3;!;PRIN DIAGNOSIS CODE",$PIECE(SRT,"^",2))=$PIECE(SRND34,"^",2)
+15 ;
+16 SET SRAA=0
FOR
SET SRAA=$ORDER(^SRF(SRTN,14,SRAA))
IF 'SRAA
QUIT
SET OCOD=$PIECE(^SRF(SRTN,14,SRAA,0),"^",3)
IF OCOD
SET SRT=$$ICDDX^ICDCODE(OCOD,SRDATE)
IF $PIECE(SRT,"^",10)=0
SET ^TMP("SRCVER",$JOB,"4;!;OTHER PREOP DIAGNOSIS",$PIECE(SRT,"^",2))=OCOD_"^"_SRAA
+17 ;
DISP IF '$DATA(^TMP("SRCVER",$JOB))
QUIT
+1 WRITE !!,DLN
+2 DO EN^DDIOL("The following codes are no longer active and will be deleted for case #:"_SRTN,,"!")
+3 SET SRAA=""
FOR
SET SRAA=$ORDER(^TMP("SRCVER",$JOB,SRAA))
IF SRAA=""
QUIT
IF SRAA["!"
WRITE !
SET (SRBB,SRCC)=""
FOR
SET SRBB=$ORDER(^TMP("SRCVER",$JOB,SRAA,SRBB))
IF SRBB=""
QUIT
SET SRCC=SRCC+1
Begin DoDot:1
+4 IF SRCC=1
WRITE !,?10,$PIECE(SRAA,";",3)_": ",?40,SRBB
IF SRCC>1
WRITE !,?40,SRBB
End DoDot:1
+5 DO EN^DDIOL("New active codes must be re-entered. A MailMan message will be sent to",,"!!")
+6 DO EN^DDIOL("the "_$SELECT(SRNON'="":"provider and attending provider",1:"surgeon and attending surgeon")_" of record and to the user who edited",,"!")
+7 DO EN^DDIOL("the record with case details for follow-up.",,"!")
+8 WRITE !!,DLN
+9 WRITE !!,"Press RETURN to continue "
READ SRX:DTIME
+10 DO SENDMSG
+11 QUIT
SENDMSG ;Send mail message when check is complete.
+1 IF '$DATA(^TMP("SRCVER",$JOB))
QUIT
+2 KILL SR,XMY
SET XMDUZ="SURGERY PACKAGE"
SET XMSUB="ICD-9 OR CPT CODE DELETION"
SET XMY(DUZ)=""
SET SLN=0
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+3 FOR SRJJ=SRPD,ATTD,DUZ
IF $GET(SRJJ)
SET XMY(SRJJ)=""
+4 SET DFN=$PIECE(^SRF(SRTN,0),"^")
DO DEM^VADPT
+5 SET SR(1)="Patient: "_$EXTRACT(VADM(1),1,20)_$JUSTIFY("",30-$LENGTH(VADM(1)))_" Case #: "_SRTN
+6 SET Y=SRDATE
DO DD^%DT
+7 SET SR(2)=$SELECT(SRNON'="":"Procedure Date: ",1:"Operation Date: ")_Y_" "_$PIECE(SROP,"^")
SET SR(3)=""
+8 SET SR(5)="The following codes are no longer active and were deleted for this"
+9 SET SR(6)="case when the "_$SELECT(SRNON'="":"Time Procedure Began",1:"Time Patient in OR")_" was entered."
+10 SET SR(7)=""
SET SLN=8
+11 SET SRX=$JUSTIFY("",8)
SET SRX1=$JUSTIFY("",40)
+12 ;
PCPT SET SRAA=0
SET SRAA=$ORDER(^TMP("SRCVER",$JOB,"1;!;PRINCIPAL CPT CODE",SRAA))
IF SRAA
SET SR(SLN)=SRX_"PRINCIPAL CPT CODE: "_SRAA
Begin DoDot:1
+1 KILL SRY
SET SRY(130,SRTN_",",27)="@"
DO FILE^DIE("","SRY")
+2 SET SRMOD=""
SET SRJJ=0
FOR
SET SRMOD=$ORDER(^TMP("SRCVER",$JOB,"1_1;; CPT MODIFIER",SRMOD))
IF SRMOD=""
QUIT
Begin DoDot:2
+3 SET SRJJ=SRJJ+1
SET SLN=SLN+1
IF SRJJ=1
SET SR(SLN)=SRX_" CPT MODIFIER:"_$JUSTIFY("",14)_SRMOD
IF SRJJ>1
SET SR(SLN)=$JUSTIFY("",36)_SRMOD
+4 KILL SRY
SET SRY(130,SRTN_",",28)="@"
DO FILE^DIE("","SRY")
End DoDot:2
End DoDot:1
+5 SET SLN=SLN+1
SET SR(SLN)=""
+6 ;
OCPT SET SRAA=0
SET SLN=SLN+1
FOR
SET SRAA=$ORDER(^TMP("SRCVER",$JOB,"2;!;OTHER PROCEDURE CPT CODE",SRAA))
IF 'SRAA
QUIT
SET SR(SLN)=SRX_"OTHER PROCEDURE CPT CODE: "_SRAA
SET SRJ=$PIECE($GET(^(SRAA)),"^",2)
Begin DoDot:1
+1 KILL SRY
SET SRY(130.16,SRJ_","_SRTN_",",3)="@"
DO FILE^DIE("","SRY")
+2 SET SRMOD=""
SET SRJJ=0
FOR
SET SRMOD=$ORDER(^TMP("SRCVER",$JOB,"2_1;; CPT MODIFIER",SRMOD))
IF SRMOD=""
QUIT
SET SRJ=$GET(^(SRMOD))
Begin DoDot:2
+3 SET SRJJ=SRJJ+1
SET SLN=SLN+1
IF SRJJ=1
SET SR(SLN)=SRX_" CPT MODIFIER:"_$JUSTIFY("",14)_SRMOD
IF SRJJ>1
SET SR(SLN)=$JUSTIFY("",36)_SRMOD
+4 KILL SRY
SET SRY(130.16,SRJ_","_SRTN_",",4)="@"
DO FILE^DIE("","SRY")
End DoDot:2
End DoDot:1
+5 ;
PD SET SRAA=0
SET SLN=SLN+1
SET SRAA=$ORDER(^TMP("SRCVER",$JOB,"3;!;PRIN DIAGNOSIS CODE",SRAA))
IF SRAA
SET SR(SLN)=SRX_"PRIN DIAGNOSIS CODE:"_SRX_SRAA
KILL SRY
SET SRY(130,SRTN_",",66)="@"
DO FILE^DIE("","SRY")
+1 ;
OPD SET (SRJJ,SRAA)=0
FOR
SET SRAA=$ORDER(^TMP("SRCVER",$JOB,"4;!;OTHER PREOP DIAGNOSIS",SRAA))
IF 'SRAA
QUIT
SET SLN=SLN+1
SET SRJJ=SRJJ+1
SET SRYY=$PIECE($GET(^(SRAA)),"^",2)
Begin DoDot:1
+1 IF SRJJ=1
SET SR(SLN)=SRX_"OTHER PREOP DIAGNOSIS:"_$JUSTIFY("",6)_SRAA
IF SRJJ>1
SET SR(SLN)=$JUSTIFY("",36)_SRAA
+2 KILL SRY
SET SRY(130.17,SRYY_","_SRTN_",",3)="@"
DO FILE^DIE("","SRY")
End DoDot:1
+3 SET (SR(SLN+1),SR(SLN+2))=""
+4 SET SR(SLN+3)="New active codes must be re-entered."
+5 SET XMTEXT="SR("
DO ^XMD
+6 ;
CFLS ;This line of code to update Surgery-CoreFLS changes
+1 IF '$DATA(^TMP("CSLSUR1",$JOB))
QUIT
+2 SET SRSITE=$SELECT($DATA(SRSITE):SRSITE,1:$$SITE^SROUTL0(SRTN))
+3 SET SROERR=SRTN
DO ^SROERR0
+4 QUIT
