SROCD3 ;BIR/ADM - ASK SC/EI QUESTIONS FOR CODING ;07/24/07
;;3.0; Surgery ;**142,152,159**;24 Jun 93;Build 4
;
; Reference to DIS^DGRPDB supported by DBIA #700
; Reference to Field #.322013 in File #2 supported by DBIA #3475
;
ASK W ! K DIR S DIR("A")="Do you want to update classification information (Y/N)? ",DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR I 'Y!$D(DTOUT)!$D(DUOUT) Q
SCEI ; output of SC/EI conditions
N SRAO,SRCV,SRDR,SREC,SRELIG,SRHNC,SRIR,SRMST,SRPERC,SRQ,SREEQ,SRSC,SRPRJ,VADM,VAEL,VASV,SRY
D DEM^VADPT,ELIG^VADPT,SVC^VADPT
S SRELIG=$P(VAEL(1),"^",2),SRSC=$P(VAEL(3),"^"),SRSC=$S(SRSC:"YES",SRSC=0:"NO",1:""),SRPERC=$P(VAEL(3),"^",2)
S SRAO=$S(VASV(2):"YES",1:"NO"),SRIR=$S(VASV(3):"YES",1:"NO"),SRCV=$S(VASV(10):"YES",1:"NO"),SRPRJ=$S($G(VASV(11)):"YES",1:"NO")
S SRMST=$S($D(SRCL(5)):"YES",1:"NO"),SRHNC=$S($D(SRCL(6)):"YES",1:"NO")
S DIC=2,DA=DFN,DR=".322013",DIQ="SRY",DIQ(0)="I" D EN^DIQ1 K DA,DIC,DIQ,DR
S SREC=SRY(2,DFN,.322013,"I"),SREC=$S(SREC="Y":"YES",1:"NO")
W @IOF,!,VADM(1)_" ("_VA("PID")_") ",$P(VAEL(6),"^",2),!!," * * * Eligibility Information and Service Connected Conditions * * *"
W !!,?5,"Primary Eligibility: "_SRELIG,!,?5,"Combat Vet: "_SRCV,?22,"A/O Exp.: "_SRAO,?39,"M/S Trauma: "_SRMST
W !,?5,"ION Rad.: "_SRIR,?22,"SWAC: "_SREC,?39,"H/N Cancer: "_SRHNC
W !,?5,"PROJ 112/SHAD: "_SRPRJ
D DIS^DGRPDB
W ! F I=1:1:79 W "-"
SUP S SRY="operation" I $D(SRTN),$P($G(^SRF(SRTN,"NON")),"^")="Y" S SRY="procedure"
K DIR W !!,"Please supply the following required information about this "_SRY_":",! S:$D(SRTN) DA=SRTN S SRDR="" S:'$D(SRQ) SRQ=0 D I SRQ G END
.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 DA,DIE,DR S:$D(SRTN) DA=SRTN,DIE=136,DR=SRDR D ^DIE
UPDX I $O(^SRO(136,SRTN,4,0)) D
.W ! K DIR S DIR("A",1)="Update all 'OTHER POSTOP DIAGNOSIS' Eligibility and Service Connected",DIR("A")="Conditions with these values (Y/N)"
.S DIR("B")="NO",DIR(0)="Y" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) Q
.I Y D UPDSC
END K DA,DIE,DR,SRZ,X,Y
Q
SC S DIR("A")="Treatment related to Service Connected condition (Y/N)",DIR(0)="136,.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 SC
S SRCL(3)=Y,SRDR=$G(SRDR)_".04////"_SRCL(3)_";"
S SRCL(3,"UPDATE")=1
Q
CV N SRCVD S SRCVD=$P(^SRO(136,DA,0),"^",10),DIR("B")=$S(SRCVD=0:"NO",1:"YES")
S DIR("A")="Treatment related to Combat (Y/N)",DIR(0)="136,.1" 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_".1////"_SRCL(7)_";"
S SRCL(7,"UPDATE")=1
Q
AO S DIR("A")="Treatment related to Agent Orange Exposure (Y/N)",DIR(0)="136,.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 AO
S SRCL(1)=Y,SRDR=SRDR_".05////"_SRCL(1)_";"
S SRCL(1,"UPDATE")=1
Q
IR S DIR("A")="Treatment related to Ionizing Radiation Exposure (Y/N)",DIR(0)="136,.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 IR
S SRCL(2)=Y,SRDR=SRDR_".06////"_SRCL(2)_";"
S SRCL(2,"UPDATE")=1
Q
EC S DIR("A")="Treatment related to SW Asia (Y/N)",DIR(0)="136,.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)_";"
S SRCL(4,"UPDATE")=1
Q
PRJ S DIR("A")="Treatment related to PROJ 112/SHAD (Y/N)",DIR(0)="136,.11" 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_".11////"_SRCL(8)_";"
S SRCL(8,"UPDATE")=1
Q
MST S DIR("A")="Treatment related to Military Sexual Trauma (Y/N)",DIR(0)="136,.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 MST
S SRCL(5)=Y,SRDR=SRDR_".08////"_SRCL(5)_";"
S SRCL(5,"UPDATE")=1
Q
HNC S DIR("A")="Treatment related to Head and/or Neck Cancer (Y/N)",DIR(0)="136,.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 HNC
S SRCL(6)=Y,SRDR=SRDR_".09////"_SRCL(6)_";"
S SRCL(6,"UPDATE")=1
Q
PRESS W ! K DIR S DIR("A")="Press RETURN to continue ",DIR(0)="FOA" D ^DIR K DIR W @IOF
Q
UPDSC ;Update existing DX to Service Connected/Environmental Indicators associations.
K DA,DIE,DR
S (DA,I)=0,DA(1)=SRTN,DIE="^SRO(136,"_SRTN_",4,"
D:$D(SRCL(1,"UPDATE")) BLDDR(.03,SRCL(1))
D:$D(SRCL(2,"UPDATE")) BLDDR(.04,SRCL(2))
D:$D(SRCL(3,"UPDATE")) BLDDR(.02,SRCL(3))
D:$D(SRCL(4,"UPDATE")) BLDDR(.07,SRCL(4))
D:$D(SRCL(5,"UPDATE")) BLDDR(.05,SRCL(5))
D:$D(SRCL(6,"UPDATE")) BLDDR(.06,SRCL(6))
D:$D(SRCL(7,"UPDATE")) BLDDR(.08,SRCL(7))
D:$D(SRCL(8,"UPDATE")) BLDDR(.09,SRCL(8))
F I=1:1 S DA=$O(^SRO(136,SRTN,4,DA)) Q:DA="" D ^DIE
Q
BLDDR(DXPIECE,NEWSC) ;Build the DR string for updating DX/Service Indicators associations
S:$D(DR) DR=DR_";"
S:'$D(DR) DR=""
S DR=DR_DXPIECE_"///"_NEWSC
K DXPIECE,NEWSC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROCD3 5168 printed Sep 23, 2025@20:19:03 Page 2
SROCD3 ;BIR/ADM - ASK SC/EI QUESTIONS FOR CODING ;07/24/07
+1 ;;3.0; Surgery ;**142,152,159**;24 Jun 93;Build 4
+2 ;
+3 ; Reference to DIS^DGRPDB supported by DBIA #700
+4 ; Reference to Field #.322013 in File #2 supported by DBIA #3475
+5 ;
ASK WRITE !
KILL DIR
SET DIR("A")="Do you want to update classification information (Y/N)? "
SET DIR("B")="NO"
SET DIR(0)="YA"
DO ^DIR
KILL DIR
IF 'Y!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
SCEI ; output of SC/EI conditions
+1 NEW SRAO,SRCV,SRDR,SREC,SRELIG,SRHNC,SRIR,SRMST,SRPERC,SRQ,SREEQ,SRSC,SRPRJ,VADM,VAEL,VASV,SRY
+2 DO DEM^VADPT
DO ELIG^VADPT
DO SVC^VADPT
+3 SET SRELIG=$PIECE(VAEL(1),"^",2)
SET SRSC=$PIECE(VAEL(3),"^")
SET SRSC=$SELECT(SRSC:"YES",SRSC=0:"NO",1:"")
SET SRPERC=$PIECE(VAEL(3),"^",2)
+4 SET SRAO=$SELECT(VASV(2):"YES",1:"NO")
SET SRIR=$SELECT(VASV(3):"YES",1:"NO")
SET SRCV=$SELECT(VASV(10):"YES",1:"NO")
SET SRPRJ=$SELECT($GET(VASV(11)):"YES",1:"NO")
+5 SET SRMST=$SELECT($DATA(SRCL(5)):"YES",1:"NO")
SET SRHNC=$SELECT($DATA(SRCL(6)):"YES",1:"NO")
+6 SET DIC=2
SET DA=DFN
SET DR=".322013"
SET DIQ="SRY"
SET DIQ(0)="I"
DO EN^DIQ1
KILL DA,DIC,DIQ,DR
+7 SET SREC=SRY(2,DFN,.322013,"I")
SET SREC=$SELECT(SREC="Y":"YES",1:"NO")
+8 WRITE @IOF,!,VADM(1)_" ("_VA("PID")_") ",$PIECE(VAEL(6),"^",2),!!," * * * Eligibility Information and Service Connected Conditions * * *"
+9 WRITE !!,?5,"Primary Eligibility: "_SRELIG,!,?5,"Combat Vet: "_SRCV,?22,"A/O Exp.: "_SRAO,?39,"M/S Trauma: "_SRMST
+10 WRITE !,?5,"ION Rad.: "_SRIR,?22,"SWAC: "_SREC,?39,"H/N Cancer: "_SRHNC
+11 WRITE !,?5,"PROJ 112/SHAD: "_SRPRJ
+12 DO DIS^DGRPDB
+13 WRITE !
FOR I=1:1:79
WRITE "-"
SUP SET SRY="operation"
IF $DATA(SRTN)
IF $PIECE($GET(^SRF(SRTN,"NON")),"^")="Y"
SET SRY="procedure"
+1 KILL DIR
WRITE !!,"Please supply the following required information about this "_SRY_":",!
if $DATA(SRTN)
SET DA=SRTN
SET SRDR=""
if '$DATA(SRQ)
SET SRQ=0
Begin DoDot:1
+2 IF $DATA(SRCL(3))
DO SC
IF SRQ
QUIT
+3 IF $DATA(SRCL(7))
DO CV
IF SRQ
QUIT
+4 IF $DATA(SRCL(1))
DO AO
IF SRQ
QUIT
+5 IF $DATA(SRCL(2))
DO IR
IF SRQ
QUIT
+6 IF $DATA(SRCL(4))
DO EC
IF SRQ
QUIT
+7 IF $DATA(SRCL(8))
DO PRJ
IF SRQ
QUIT
+8 IF $DATA(SRCL(5))
DO MST
IF SRQ
QUIT
+9 IF $DATA(SRCL(6))
DO HNC
End DoDot:1
IF SRQ
GOTO END
+10 KILL DA,DIE,DR
if $DATA(SRTN)
SET DA=SRTN
SET DIE=136
SET DR=SRDR
DO ^DIE
UPDX IF $ORDER(^SRO(136,SRTN,4,0))
Begin DoDot:1
+1 WRITE !
KILL DIR
SET DIR("A",1)="Update all 'OTHER POSTOP DIAGNOSIS' Eligibility and Service Connected"
SET DIR("A")="Conditions with these values (Y/N)"
+2 SET DIR("B")="NO"
SET DIR(0)="Y"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+3 IF Y
DO UPDSC
End DoDot:1
END KILL DA,DIE,DR,SRZ,X,Y
+1 QUIT
SC SET DIR("A")="Treatment related to Service Connected condition (Y/N)"
SET DIR(0)="136,.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 SC
+2 SET SRCL(3)=Y
SET SRDR=$GET(SRDR)_".04////"_SRCL(3)_";"
+3 SET SRCL(3,"UPDATE")=1
+4 QUIT
CV NEW SRCVD
SET SRCVD=$PIECE(^SRO(136,DA,0),"^",10)
SET DIR("B")=$SELECT(SRCVD=0:"NO",1:"YES")
+1 SET DIR("A")="Treatment related to Combat (Y/N)"
SET DIR(0)="136,.1"
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_".1////"_SRCL(7)_";"
+4 SET SRCL(7,"UPDATE")=1
+5 QUIT
AO SET DIR("A")="Treatment related to Agent Orange Exposure (Y/N)"
SET DIR(0)="136,.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 AO
+2 SET SRCL(1)=Y
SET SRDR=SRDR_".05////"_SRCL(1)_";"
+3 SET SRCL(1,"UPDATE")=1
+4 QUIT
IR SET DIR("A")="Treatment related to Ionizing Radiation Exposure (Y/N)"
SET DIR(0)="136,.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 IR
+2 SET SRCL(2)=Y
SET SRDR=SRDR_".06////"_SRCL(2)_";"
+3 SET SRCL(2,"UPDATE")=1
+4 QUIT
EC SET DIR("A")="Treatment related to SW Asia (Y/N)"
SET DIR(0)="136,.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 SET SRCL(4,"UPDATE")=1
+4 QUIT
PRJ SET DIR("A")="Treatment related to PROJ 112/SHAD (Y/N)"
SET DIR(0)="136,.11"
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_".11////"_SRCL(8)_";"
+3 SET SRCL(8,"UPDATE")=1
+4 QUIT
MST SET DIR("A")="Treatment related to Military Sexual Trauma (Y/N)"
SET DIR(0)="136,.08"
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_".08////"_SRCL(5)_";"
+3 SET SRCL(5,"UPDATE")=1
+4 QUIT
HNC SET DIR("A")="Treatment related to Head and/or Neck Cancer (Y/N)"
SET DIR(0)="136,.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 HNC
+2 SET SRCL(6)=Y
SET SRDR=SRDR_".09////"_SRCL(6)_";"
+3 SET SRCL(6,"UPDATE")=1
+4 QUIT
PRESS WRITE !
KILL DIR
SET DIR("A")="Press RETURN to continue "
SET DIR(0)="FOA"
DO ^DIR
KILL DIR
WRITE @IOF
+1 QUIT
UPDSC ;Update existing DX to Service Connected/Environmental Indicators associations.
+1 KILL DA,DIE,DR
+2 SET (DA,I)=0
SET DA(1)=SRTN
SET DIE="^SRO(136,"_SRTN_",4,"
+3 if $DATA(SRCL(1,"UPDATE"))
DO BLDDR(.03,SRCL(1))
+4 if $DATA(SRCL(2,"UPDATE"))
DO BLDDR(.04,SRCL(2))
+5 if $DATA(SRCL(3,"UPDATE"))
DO BLDDR(.02,SRCL(3))
+6 if $DATA(SRCL(4,"UPDATE"))
DO BLDDR(.07,SRCL(4))
+7 if $DATA(SRCL(5,"UPDATE"))
DO BLDDR(.05,SRCL(5))
+8 if $DATA(SRCL(6,"UPDATE"))
DO BLDDR(.06,SRCL(6))
+9 if $DATA(SRCL(7,"UPDATE"))
DO BLDDR(.08,SRCL(7))
+10 if $DATA(SRCL(8,"UPDATE"))
DO BLDDR(.09,SRCL(8))
+11 FOR I=1:1
SET DA=$ORDER(^SRO(136,SRTN,4,DA))
if DA=""
QUIT
DO ^DIE
+12 QUIT
BLDDR(DXPIECE,NEWSC) ;Build the DR string for updating DX/Service Indicators associations
+1 if $DATA(DR)
SET DR=DR_";"
+2 if '$DATA(DR)
SET DR=""
+3 SET DR=DR_DXPIECE_"///"_NEWSC
+4 KILL DXPIECE,NEWSC
+5 QUIT
