- 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 Jan 18, 2025@03:43:44 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