SROCD ;BIR/ADM - CASE CODING IN SURGERY PROCEDURE/DIAGNOSIS CODES FILE ;07/24/07
;;3.0; Surgery ;**142,152,159**;24 Jun 93;Build 4
I '$D(SRSITE) D ^SROVAR I '$D(SRSITE) S XQUIT="" Q
I '$G(SRTN) D ^SROPS1 I '$D(SRTN) S XQUIT="" Q
BEG N S,SR2,SRCMOD,SRDES,SRDX,SREDIT,SRHDR,SRMOD,SRNM,SRPROC,SRS,SRSEL,SRTXT
S (SREDIT,SRMOD,SRSOUT,SRS,SR2)=0 I $P($G(^SRF(SRTN,.2)),"^",3) S SRS=1
S S(0)=^SRF(SRTN,0),Y=$P(S(0),"^",9),SRDATE=Y D D^DIQ S SRSDATE=Y,DFN=$P(S(0),"^") D DEM^VADPT S SRNM=VADM(1)_" ("_VA("PID")_")"
S SRNON=$S($P($G(^SRF(SRTN,"NON")),"^")="Y":1,1:0)
I '$D(^SRO(136,SRTN)) D ^SROCD1
I $P($G(^SRO(136,SRTN,10)),"^") D SURE I 'SREDIT Q
EDIT D ^SROCD2 I SRSOUT!SREDIT G END
D EDIT
Q
SURE D HDR K DIR
S DIR("A",1)="Coding for this case has been completed "_$S($P(^SRF(SRTN,0),"^",15):"and",1:"but not")_" sent to PCE."
S DIR("A",2)="",DIR("A")="Are you sure you want to edit this case",DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
I Y S SREDIT=1 M ^TMP("SRED1",$J,SRTN)=^SRO(136,SRTN) Q
END S SROERR=SRTN D ^SROERR0,^SRSKILL
K ADCNT,SRCOMMA,SRDXCNT,SROCNTR,SROCPT2,SROERR,SROFLG,SRTMP,SRICD9,SRDIAGS,SRASDX,SRMSG,SRADX,SRPADX,SRODIR,REC,SRDIRX,SRADIAG,SRDX,SRDX1,SRDX2,SROICD,SUB4
W @IOF K ^TMP("SRED1",$J)
Q
HDR W @IOF,!,SRNM_" Case #"_SRTN,!
S SRPROC=$P(^SRF(SRTN,"OP"),"^") D BRK W $P(SRSDATE,"@")_" "_SRHDR(1)
I $D(SRHDR(2)) W !,?15,SRHDR(2) I $D(SRHDR(3)) W !,?15,SRHDR(3)
W ! F I=1:1:80 W "-"
Q
BRK ; break procedure if greater than 65 characters
I $L(SRPROC)<66 S SRHDR(1)=SRPROC Q
S X=SRPROC,K=1 F D I $L(X)<66 S SRHDR(K)=X Q
.F I=0:1:64 S J=65-I,Y=$E(X,J) I Y=" " S SRHDR(K)=$E(X,1,J-1),X=$E(X,J+1,$L(X)) S K=K+1 Q
Q
OSCEI ; update SC/EI info on other diagnosis
K DA,DIE,DR,DIR W !!,"Please supply the following required information related to this diagnosis:",!
S SRDR="",SRQ=0 S DA=$P(SRSEL(SRDA),U),DA(1)=SRTN D I SRQ Q
.I $D(SRCL(3)) D SC I SRQ Q
.I $D(SRCL(7)) D CV I SRQ Q
.I $D(SRCL(1)) D AO I SRQ Q
.I $D(SRCL(2)) D IR I SRQ Q
.I $D(SRCL(4)) D EC I SRQ Q
.I $D(SRCL(8)) D PRJ I SRQ Q
.I $D(SRCL(5)) D MST I SRQ Q
.I $D(SRCL(6)) D HNC
K DIR S DA=$P(SRSEL(SRDA),U),DA(1)=SRTN,DIE="^SRO(136,SRTN,4,",DR=SRDR D ^DIE K DA,DIE,DR,SRDR
Q
SC S DIR("A")="Treatment related to Service Connected condition (Y/N)",DIR(0)="136.04,.02" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G SC
S SRCL(3)=Y,SRDR=$G(SRDR)_".02////"_SRCL(3)_";"
Q
CV N SRCVD S SRCVD=$P($G(^SRO(136,DA(1),4,DA,0)),"^",8),DIR("B")=$S(SRCVD=0:"NO",1:"YES")
S DIR("A")="Treatment related to Combat (Y/N)",DIR(0)="136.04,.08" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G CV
S SRCL(7)=Y,SRDR=SRDR_".08////"_SRCL(7)_";"
Q
AO S DIR("A")="Treatment related to Agent Orange Exposure (Y/N)",DIR(0)="136.04,.03" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G AO
S SRCL(1)=Y,SRDR=SRDR_".03////"_SRCL(1)_";"
Q
IR S DIR("A")="Treatment related to Ionizing Radiation Exposure (Y/N)",DIR(0)="136.04,.04" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G IR
S SRCL(2)=Y,SRDR=SRDR_".04////"_SRCL(2)_";"
Q
EC S DIR("A")="Treatment related to SW Asia (Y/N)",DIR(0)="136.04,.07" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G EC
S SRCL(4)=Y,SRDR=SRDR_".07////"_SRCL(4)_";"
Q
PRJ S DIR("A")="Treatment related to PROJ 112/SHAD (Y/N)",DIR(0)="136.04,.09" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G PRJ
S SRCL(8)=Y,SRDR=SRDR_".09////"_SRCL(8)_";"
Q
MST S DIR("A")="Treatment related to Military Sexual Trauma (Y/N)",DIR(0)="136.04,.05" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G MST
S SRCL(5)=Y,SRDR=SRDR_".05////"_SRCL(5)_";"
Q
HNC S DIR("A")="Treatment related to Head and/or Neck Cancer (Y/N)",DIR(0)="136.04,.06" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G HNC
S SRCL(6)=Y,SRDR=SRDR_".06////"_SRCL(6)_";"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROCD 4202 printed Nov 22, 2024@17:52:32 Page 2
SROCD ;BIR/ADM - CASE CODING IN SURGERY PROCEDURE/DIAGNOSIS CODES FILE ;07/24/07
+1 ;;3.0; Surgery ;**142,152,159**;24 Jun 93;Build 4
+2 IF '$DATA(SRSITE)
DO ^SROVAR
IF '$DATA(SRSITE)
SET XQUIT=""
QUIT
+3 IF '$GET(SRTN)
DO ^SROPS1
IF '$DATA(SRTN)
SET XQUIT=""
QUIT
BEG NEW S,SR2,SRCMOD,SRDES,SRDX,SREDIT,SRHDR,SRMOD,SRNM,SRPROC,SRS,SRSEL,SRTXT
+1 SET (SREDIT,SRMOD,SRSOUT,SRS,SR2)=0
IF $PIECE($GET(^SRF(SRTN,.2)),"^",3)
SET SRS=1
+2 SET S(0)=^SRF(SRTN,0)
SET Y=$PIECE(S(0),"^",9)
SET SRDATE=Y
DO D^DIQ
SET SRSDATE=Y
SET DFN=$PIECE(S(0),"^")
DO DEM^VADPT
SET SRNM=VADM(1)_" ("_VA("PID")_")"
+3 SET SRNON=$SELECT($PIECE($GET(^SRF(SRTN,"NON")),"^")="Y":1,1:0)
+4 IF '$DATA(^SRO(136,SRTN))
DO ^SROCD1
+5 IF $PIECE($GET(^SRO(136,SRTN,10)),"^")
DO SURE
IF 'SREDIT
QUIT
EDIT DO ^SROCD2
IF SRSOUT!SREDIT
GOTO END
+1 DO EDIT
+2 QUIT
SURE DO HDR
KILL DIR
+1 SET DIR("A",1)="Coding for this case has been completed "_$SELECT($PIECE(^SRF(SRTN,0),"^",15):"and",1:"but not")_" sent to PCE."
+2 SET DIR("A",2)=""
SET DIR("A")="Are you sure you want to edit this case"
SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
+3 IF Y
SET SREDIT=1
MERGE ^TMP("SRED1",$JOB,SRTN)=^SRO(136,SRTN)
QUIT
END SET SROERR=SRTN
DO ^SROERR0
DO ^SRSKILL
+1 KILL ADCNT,SRCOMMA,SRDXCNT,SROCNTR,SROCPT2,SROERR,SROFLG,SRTMP,SRICD9,SRDIAGS,SRASDX,SRMSG,SRADX,SRPADX,SRODIR,REC,SRDIRX,SRADIAG,SRDX,SRDX1,SRDX2,SROICD,SUB4
+2 WRITE @IOF
KILL ^TMP("SRED1",$JOB)
+3 QUIT
HDR WRITE @IOF,!,SRNM_" Case #"_SRTN,!
+1 SET SRPROC=$PIECE(^SRF(SRTN,"OP"),"^")
DO BRK
WRITE $PIECE(SRSDATE,"@")_" "_SRHDR(1)
+2 IF $DATA(SRHDR(2))
WRITE !,?15,SRHDR(2)
IF $DATA(SRHDR(3))
WRITE !,?15,SRHDR(3)
+3 WRITE !
FOR I=1:1:80
WRITE "-"
+4 QUIT
BRK ; break procedure if greater than 65 characters
+1 IF $LENGTH(SRPROC)<66
SET SRHDR(1)=SRPROC
QUIT
+2 SET X=SRPROC
SET K=1
FOR
Begin DoDot:1
+3 FOR I=0:1:64
SET J=65-I
SET Y=$EXTRACT(X,J)
IF Y=" "
SET SRHDR(K)=$EXTRACT(X,1,J-1)
SET X=$EXTRACT(X,J+1,$LENGTH(X))
SET K=K+1
QUIT
End DoDot:1
IF $LENGTH(X)<66
SET SRHDR(K)=X
QUIT
+4 QUIT
OSCEI ; update SC/EI info on other diagnosis
+1 KILL DA,DIE,DR,DIR
WRITE !!,"Please supply the following required information related to this diagnosis:",!
+2 SET SRDR=""
SET SRQ=0
SET DA=$PIECE(SRSEL(SRDA),U)
SET DA(1)=SRTN
Begin DoDot:1
+3 IF $DATA(SRCL(3))
DO SC
IF SRQ
QUIT
+4 IF $DATA(SRCL(7))
DO CV
IF SRQ
QUIT
+5 IF $DATA(SRCL(1))
DO AO
IF SRQ
QUIT
+6 IF $DATA(SRCL(2))
DO IR
IF SRQ
QUIT
+7 IF $DATA(SRCL(4))
DO EC
IF SRQ
QUIT
+8 IF $DATA(SRCL(8))
DO PRJ
IF SRQ
QUIT
+9 IF $DATA(SRCL(5))
DO MST
IF SRQ
QUIT
+10 IF $DATA(SRCL(6))
DO HNC
End DoDot:1
IF SRQ
QUIT
+11 KILL DIR
SET DA=$PIECE(SRSEL(SRDA),U)
SET DA(1)=SRTN
SET DIE="^SRO(136,SRTN,4,"
SET DR=SRDR
DO ^DIE
KILL DA,DIE,DR,SRDR
+12 QUIT
SC SET DIR("A")="Treatment related to Service Connected condition (Y/N)"
SET DIR(0)="136.04,.02"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRQ=1
QUIT
+1 IF X=""!(X="@")
WRITE !,$CHAR(7),?15,"Enter YES or NO."
GOTO SC
+2 SET SRCL(3)=Y
SET SRDR=$GET(SRDR)_".02////"_SRCL(3)_";"
+3 QUIT
CV NEW SRCVD
SET SRCVD=$PIECE($GET(^SRO(136,DA(1),4,DA,0)),"^",8)
SET DIR("B")=$SELECT(SRCVD=0:"NO",1:"YES")
+1 SET DIR("A")="Treatment related to Combat (Y/N)"
SET DIR(0)="136.04,.08"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRQ=1
QUIT
+2 IF X=""!(X="@")
WRITE !,$CHAR(7),?15,"Enter YES or NO."
GOTO CV
+3 SET SRCL(7)=Y
SET SRDR=SRDR_".08////"_SRCL(7)_";"
+4 QUIT
AO SET DIR("A")="Treatment related to Agent Orange Exposure (Y/N)"
SET DIR(0)="136.04,.03"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRQ=1
QUIT
+1 IF X=""!(X="@")
WRITE !,$CHAR(7),?15,"Enter YES or NO."
GOTO AO
+2 SET SRCL(1)=Y
SET SRDR=SRDR_".03////"_SRCL(1)_";"
+3 QUIT
IR SET DIR("A")="Treatment related to Ionizing Radiation Exposure (Y/N)"
SET DIR(0)="136.04,.04"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRQ=1
QUIT
+1 IF X=""!(X="@")
WRITE !,$CHAR(7),?15,"Enter YES or NO."
GOTO IR
+2 SET SRCL(2)=Y
SET SRDR=SRDR_".04////"_SRCL(2)_";"
+3 QUIT
EC SET DIR("A")="Treatment related to SW Asia (Y/N)"
SET DIR(0)="136.04,.07"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRQ=1
QUIT
+1 IF X=""!(X="@")
WRITE !,$CHAR(7),?15,"Enter YES or NO."
GOTO EC
+2 SET SRCL(4)=Y
SET SRDR=SRDR_".07////"_SRCL(4)_";"
+3 QUIT
PRJ SET DIR("A")="Treatment related to PROJ 112/SHAD (Y/N)"
SET DIR(0)="136.04,.09"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRQ=1
QUIT
+1 IF X=""!(X="@")
WRITE !,$CHAR(7),?15,"Enter YES or NO."
GOTO PRJ
+2 SET SRCL(8)=Y
SET SRDR=SRDR_".09////"_SRCL(8)_";"
+3 QUIT
MST SET DIR("A")="Treatment related to Military Sexual Trauma (Y/N)"
SET DIR(0)="136.04,.05"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRQ=1
QUIT
+1 IF X=""!(X="@")
WRITE !,$CHAR(7),?15,"Enter YES or NO."
GOTO MST
+2 SET SRCL(5)=Y
SET SRDR=SRDR_".05////"_SRCL(5)_";"
+3 QUIT
HNC SET DIR("A")="Treatment related to Head and/or Neck Cancer (Y/N)"
SET DIR(0)="136.04,.06"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRQ=1
QUIT
+1 IF X=""!(X="@")
WRITE !,$CHAR(7),?15,"Enter YES or NO."
GOTO HNC
+2 SET SRCL(6)=Y
SET SRDR=SRDR_".06////"_SRCL(6)_";"
+3 QUIT
