SROPCE1 ;BIR/ADM - ASK SC/EI QUESTIONS FOR PCE AND CROSS REFERENCE LOGIC ;07/24/07
;;3.0;Surgery;**58,105,119,150,152,159,177**;24 Jun 93;Build 89
;
; Reference to CL^SDCO21 supported by DBIA #406
; Reference to DIS^DGRPDB supported by DBIA #700
; Reference to Field #.322013 in File #2 supported by DBIA #3475
;
EN1 I '$P(^SRO(133,SRSITE,0),"^",16) Q
N SRPDATE,SRSDATE S SRPDATE=$P(^SRO(133,SRSITE,0),"^",17),SRSDATE=$S($D(SRTN):$P(^SRF(SRTN,0),"^",9),$D(SRWLST):$P(^SRO(133.8,SRSS,1,SROFN,0),"^",5),1:DT) I SRPDATE,SRSDATE<SRPDATE Q
N SRAO,SRDR,SREC,SRELIG,SRIR,SRPERC,SRQ,SRSC,SRCL,SRX,VAEL,VASV,SRCV,SRMST,SRHNC,SRPRJ S SRQ=0
CLASS ; build classification array
S:$D(SRTN) DFN=$P(^SRF(SRTN,0),"^") D CL^SDCO21(DFN,SRSDATE,,.SRCL)
I '$D(SRCL) W !!,"No classification information is required for this patient.",! K DA,DIE,DR S:$D(SRTN) DA=SRTN,DIE=130,DR=".0155////1" S:$D(SRWLST) DA(1)=SRSS,DA=SROFN,DIE="^SRO(133.8,"_DA(1)_",1,",DR="20////1" D ^DIE G END
I $D(SRTN),'$P(^SRF(SRTN,0),"^",20) G ELIG
I $D(SRWLST),'$P(^SRO(133.8,SRSS,1,SROFN,0),"^",20) G ELIG
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) W:'$D(SRWLST) @IOF Q
ELIG ; output of eligibility and service connected conditions
N 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(SRWLST) DA(1)=SRSS,DA=SROFN S:$D(SRTN) DA=SRTN S SRDR="" S:'$D(SRQ) SRQ=0 D I SRQ S:$D(SRWLST) SRSOUT=1 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=130,DR=SRDR_".0155////1" S:$D(SRWLST) DA(1)=SRSS,DA=SROFN,DIE="^SRO(133.8,"_DA(1)_",1,",DR=SRDR_"20////1"
D ^DIE
UPDX I $D(SRTN),X,$D(^SRF(SRTN,15)) D
.R !!,"Update all 'OTHER POSTOP DIAGNOSIS' Eligibility and",!,"Service Connected Conditions with these values? Enter YES or NO. <NO>",Z:DTIME S:'$T Z=""
.D:(Z["Y")!(Z["y") UPDSC
.I Z["?" D G UPDX
..W !!,"Associate all of the existing OTHER POSTOP DIAGNOSIS for this surgical case with the new Eligibility and Service Connected Conditions?"
..W !,"To edit diagnoses classification status individually, please use the Physician's Verification or the CPT/ICD Coding screens"
END K DA,DIE,DR,SRZ,X,Y I 'SRQ,'$D(SRREQ),'$D(SRWLST) D PRESS
Q
SC S DIR("A")="Treatment related to Service Connected condition (Y/N)",DIR(0)=$S($D(SRWLST):"133.801,16",1:"130,.016") 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)_$S($D(SRWLST):"16",1:".016")_"////"_SRCL(3)_";"
S SRCL(3,"UPDATE")=1
Q
CV N SRCVD S SRCVD=$S($D(SRWLST):$P(^SRO(133.8,SRSS,1,SROFN,0),"^",23),1:$P(^SRF(SRTN,0),"^",24)),DIR("B")=$S(SRCVD=0:"NO",1:"YES")
S DIR("A")="Treatment related to Combat (Y/N)",DIR(0)=$S($D(SRWLST):"133.801,23",1:"130,.024") 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_$S($D(SRWLST):"23",1:".024")_"////"_SRCL(7)_";"
S SRCL(7,"UPDATE")=1
Q
AO S DIR("A")="Treatment related to Agent Orange Exposure (Y/N)",DIR(0)=$S($D(SRWLST):"133.801,17",1:"130,.017") 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_$S($D(SRWLST):"17",1:".017")_"////"_SRCL(1)_";"
S SRCL(1,"UPDATE")=1
Q
IR S DIR("A")="Treatment related to Ionizing Radiation Exposure (Y/N)",DIR(0)=$S($D(SRWLST):"133.801,18",1:"130,.018") 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_$S($D(SRWLST):"18",1:".018")_"////"_SRCL(2)_";"
S SRCL(2,"UPDATE")=1
Q
EC S DIR("A")="Treatment related to SW Asia (Y/N)",DIR(0)=$S($D(SRWLST):"133.801,19",1:"130,.019") 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_$S($D(SRWLST):"19",1:".019")_"////"_SRCL(4)_";"
S SRCL(4,"UPDATE")=1
Q
PRJ S DIR("A")="Treatment related to PROJ 112/SHAD (Y/N)",DIR(0)=$S($D(SRWLST):"133.801,24",1:"130,.026") 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_$S($D(SRWLST):"24",1:".026")_"////"_SRCL(8)_";"
S SRCL(8,"UPDATE")=1
Q
MST S DIR("A")="Treatment related to Military Sexual Trauma (Y/N)",DIR(0)=$S($D(SRWLST):"133.801,21",1:"130,.022") 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_$S($D(SRWLST):"21",1:".022")_"////"_SRCL(5)_";"
S SRCL(5,"UPDATE")=1
Q
HNC S DIR("A")="Treatment related to Head and/or Neck Cancer (Y/N)",DIR(0)=$S($D(SRWLST):"133.801,22",1:"130,.023") 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_$S($D(SRWLST):"22",1:".023")_"////"_SRCL(6)_";"
S SRCL(6,"UPDATE")=1
Q
WL ; entry from waiting list
N SRWLST S SRWLST=1 G EN1
Q
REQ ; entry from new request entry
N SRREQ S SRREQ=1 G EN1
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
S (DA,I)=0,DA(1)=SRTN,DIE="^SRF("_SRTN_",15,"
K DR
D:$D(SRCL(1,"UPDATE")) BLDDR(5,SRCL(1))
D:$D(SRCL(2,"UPDATE")) BLDDR(6,SRCL(2))
D:$D(SRCL(3,"UPDATE")) BLDDR(4,SRCL(3))
D:$D(SRCL(4,"UPDATE")) BLDDR(9,SRCL(4))
D:$D(SRCL(5,"UPDATE")) BLDDR(7,SRCL(5))
D:$D(SRCL(6,"UPDATE")) BLDDR(8,SRCL(6))
D:$D(SRCL(7,"UPDATE")) BLDDR(10,SRCL(7))
D:$D(SRCL(8,"UPDATE")) BLDDR(11,SRCL(8))
F I=1:1 S DA=$O(^SRF(SRTN,15,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[HSROPCE1 7047 printed Dec 13, 2024@02:44:54 Page 2
SROPCE1 ;BIR/ADM - ASK SC/EI QUESTIONS FOR PCE AND CROSS REFERENCE LOGIC ;07/24/07
+1 ;;3.0;Surgery;**58,105,119,150,152,159,177**;24 Jun 93;Build 89
+2 ;
+3 ; Reference to CL^SDCO21 supported by DBIA #406
+4 ; Reference to DIS^DGRPDB supported by DBIA #700
+5 ; Reference to Field #.322013 in File #2 supported by DBIA #3475
+6 ;
EN1 IF '$PIECE(^SRO(133,SRSITE,0),"^",16)
QUIT
+1 NEW SRPDATE,SRSDATE
SET SRPDATE=$PIECE(^SRO(133,SRSITE,0),"^",17)
SET SRSDATE=$SELECT($DATA(SRTN):$PIECE(^SRF(SRTN,0),"^",9),$DATA(SRWLST):$PIECE(^SRO(133.8,SRSS,1,SROFN,0),"^",5),1:DT)
IF SRPDATE
IF SRSDATE<SRPDATE
QUIT
+2 NEW SRAO,SRDR,SREC,SRELIG,SRIR,SRPERC,SRQ,SRSC,SRCL,SRX,VAEL,VASV,SRCV,SRMST,SRHNC,SRPRJ
SET SRQ=0
CLASS ; build classification array
+1 if $DATA(SRTN)
SET DFN=$PIECE(^SRF(SRTN,0),"^")
DO CL^SDCO21(DFN,SRSDATE,,.SRCL)
+2 IF '$DATA(SRCL)
WRITE !!,"No classification information is required for this patient.",!
KILL DA,DIE,DR
if $DATA(SRTN)
SET DA=SRTN
SET DIE=130
SET DR=".0155////1"
if $DATA(SRWLST)
SET DA(1)=SRSS
SET DA=SROFN
SET DIE="^SRO(133.8,"_DA(1)_",1,"
SET DR="20////1"
DO ^DIE
GOTO END
+3 IF $DATA(SRTN)
IF '$PIECE(^SRF(SRTN,0),"^",20)
GOTO ELIG
+4 IF $DATA(SRWLST)
IF '$PIECE(^SRO(133.8,SRSS,1,SROFN,0),"^",20)
GOTO ELIG
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)
if '$DATA(SRWLST)
WRITE @IOF
QUIT
ELIG ; output of eligibility and service connected conditions
+1 NEW SRY
DO DEM^VADPT
DO ELIG^VADPT
DO SVC^VADPT
+2 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)
+3 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")
+4 SET SRMST=$SELECT($DATA(SRCL(5)):"YES",1:"NO")
SET SRHNC=$SELECT($DATA(SRCL(6)):"YES",1:"NO")
+5 SET DIC=2
SET DA=DFN
SET DR=".322013"
SET DIQ="SRY"
SET DIQ(0)="I"
DO EN^DIQ1
KILL DA,DIC,DIQ,DR
+6 SET SREC=SRY(2,DFN,.322013,"I")
SET SREC=$SELECT(SREC="Y":"YES",1:"NO")
+7 WRITE @IOF,!,VADM(1)_" ("_VA("PID")_") ",$PIECE(VAEL(6),"^",2),!!," * * * Eligibility Information and Service Connected Conditions * * *"
+8 WRITE !!,?5,"Primary Eligibility: "_SRELIG,!,?5,"Combat Vet: "_SRCV,?22,"A/O Exp.: "_SRAO,?39,"M/S Trauma: "_SRMST
+9 WRITE !,?5,"ION Rad.: "_SRIR,?22,"SWAC: "_SREC,?39,"H/N Cancer: "_SRHNC
+10 WRITE !,?5,"PROJ 112/SHAD: "_SRPRJ
+11 DO DIS^DGRPDB
+12 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(SRWLST)
SET DA(1)=SRSS
SET DA=SROFN
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
if $DATA(SRWLST)
SET SRSOUT=1
GOTO END
+10 KILL DA,DIE,DR
if $DATA(SRTN)
SET DA=SRTN
SET DIE=130
SET DR=SRDR_".0155////1"
if $DATA(SRWLST)
SET DA(1)=SRSS
SET DA=SROFN
SET DIE="^SRO(133.8,"_DA(1)_",1,"
SET DR=SRDR_"20////1"
+11 DO ^DIE
UPDX IF $DATA(SRTN)
IF X
IF $DATA(^SRF(SRTN,15))
Begin DoDot:1
+1 READ !!,"Update all 'OTHER POSTOP DIAGNOSIS' Eligibility and",!,"Service Connected Conditions with these values? Enter YES or NO. <NO>",Z:DTIME
if '$TEST
SET Z=""
+2 if (Z["Y")!(Z["y")
DO UPDSC
+3 IF Z["?"
Begin DoDot:2
+4 WRITE !!,"Associate all of the existing OTHER POSTOP DIAGNOSIS for this surgical case with the new Eligibility and Service Connected Conditions?"
+5 WRITE !,"To edit diagnoses classification status individually, please use the Physician's Verification or the CPT/ICD Coding screens"
End DoDot:2
GOTO UPDX
End DoDot:1
END KILL DA,DIE,DR,SRZ,X,Y
IF 'SRQ
IF '$DATA(SRREQ)
IF '$DATA(SRWLST)
DO PRESS
+1 QUIT
SC SET DIR("A")="Treatment related to Service Connected condition (Y/N)"
SET DIR(0)=$SELECT($DATA(SRWLST):"133.801,16",1:"130,.016")
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)_$SELECT($DATA(SRWLST):"16",1:".016")_"////"_SRCL(3)_";"
+3 SET SRCL(3,"UPDATE")=1
+4 QUIT
CV NEW SRCVD
SET SRCVD=$SELECT($DATA(SRWLST):$PIECE(^SRO(133.8,SRSS,1,SROFN,0),"^",23),1:$PIECE(^SRF(SRTN,0),"^",24))
SET DIR("B")=$SELECT(SRCVD=0:"NO",1:"YES")
+1 SET DIR("A")="Treatment related to Combat (Y/N)"
SET DIR(0)=$SELECT($DATA(SRWLST):"133.801,23",1:"130,.024")
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_$SELECT($DATA(SRWLST):"23",1:".024")_"////"_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)=$SELECT($DATA(SRWLST):"133.801,17",1:"130,.017")
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_$SELECT($DATA(SRWLST):"17",1:".017")_"////"_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)=$SELECT($DATA(SRWLST):"133.801,18",1:"130,.018")
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_$SELECT($DATA(SRWLST):"18",1:".018")_"////"_SRCL(2)_";"
+3 SET SRCL(2,"UPDATE")=1
+4 QUIT
EC SET DIR("A")="Treatment related to SW Asia (Y/N)"
SET DIR(0)=$SELECT($DATA(SRWLST):"133.801,19",1:"130,.019")
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_$SELECT($DATA(SRWLST):"19",1:".019")_"////"_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)=$SELECT($DATA(SRWLST):"133.801,24",1:"130,.026")
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_$SELECT($DATA(SRWLST):"24",1:".026")_"////"_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)=$SELECT($DATA(SRWLST):"133.801,21",1:"130,.022")
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_$SELECT($DATA(SRWLST):"21",1:".022")_"////"_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)=$SELECT($DATA(SRWLST):"133.801,22",1:"130,.023")
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_$SELECT($DATA(SRWLST):"22",1:".023")_"////"_SRCL(6)_";"
+3 SET SRCL(6,"UPDATE")=1
+4 QUIT
WL ; entry from waiting list
+1 NEW SRWLST
SET SRWLST=1
GOTO EN1
+2 QUIT
REQ ; entry from new request entry
+1 NEW SRREQ
SET SRREQ=1
GOTO EN1
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
+2 SET (DA,I)=0
SET DA(1)=SRTN
SET DIE="^SRF("_SRTN_",15,"
+3 KILL DR
+4 if $DATA(SRCL(1,"UPDATE"))
DO BLDDR(5,SRCL(1))
+5 if $DATA(SRCL(2,"UPDATE"))
DO BLDDR(6,SRCL(2))
+6 if $DATA(SRCL(3,"UPDATE"))
DO BLDDR(4,SRCL(3))
+7 if $DATA(SRCL(4,"UPDATE"))
DO BLDDR(9,SRCL(4))
+8 if $DATA(SRCL(5,"UPDATE"))
DO BLDDR(7,SRCL(5))
+9 if $DATA(SRCL(6,"UPDATE"))
DO BLDDR(8,SRCL(6))
+10 if $DATA(SRCL(7,"UPDATE"))
DO BLDDR(10,SRCL(7))
+11 if $DATA(SRCL(8,"UPDATE"))
DO BLDDR(11,SRCL(8))
+12 FOR I=1:1
SET DA=$ORDER(^SRF(SRTN,15,DA))
if DA=""
QUIT
DO ^DIE
+13 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
