- 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 Jan 18, 2025@03:46:05 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