- SRTPRACE ;BIR/SJA - RACE INFORMATION ;03/27/08
- ;;3.0; Surgery ;**167**;24 Jun 93;Build 27
- N RAC,I,SRY,CNT,SRPAGE,SRYN S $P(SRLINE,"-",80)=""
- S SRSOUT=0 I '$D(SRTPP) W @IOF,!!,"A transplant assessment must be selected prior to using this option.",!!,"Press RETURN to continue " R X:DTIME S SRSOUT=1 G END
- START S SRPAGE="RACE INFORMATION" D HDR
- K SRORAC S (RAC,CNT)=0 F S RAC=$O(^SRT(SRTPP,44,RAC)) Q:'RAC!($D(SRORAC)) Q:SRSOUT S CNT=CNT+1 D LIST I CNT=13 W !!,SRLINE D SEL
- I SRSOUT Q
- I $D(SRORAC) D EDIT G START
- I CNT W !!,SRLINE
- I CNT=0 D ASK G:'SRSOUT START S SRSOUT=0 Q
- OPT W !!,"Enter "_$S(CNT=1:1,1:"(1-"_CNT_")")_" to edit an existing race, or 'NEW' to enter another race code: " R X:DTIME I '$T!("^"[X) Q
- I "Nn"[$E(X) D NEW G START
- I '$D(SRACE(X)) W !!,"Select the number corresponding to the race you want to edit, or 'NEW' to",!,"enter an additional race information." G OPT
- S SRORAC=$P(SRACE(X),"^",3) D EDIT G START
- Q
- END I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
- D ^SRSKILL W @IOF
- Q
- LIST ; list existing race
- K SRY S DIC="^SRT(",DR=44,DA=SRTPP,DR(139.544)=".01",DA(139.544)=RAC,DIQ="SRY",DIQ(0)="E" D EN^DIQ1
- S SRACE(CNT)=$G(^SRT(SRTPP,44,RAC,0))_"^"_$G(SRY(139.544,RAC,.01,"E"))_"^"_RAC
- W !,$S(CNT<10:" ",1:"")_CNT_". "_$P(SRACE(CNT),"^",2)
- Q
- SEL ; select race
- W !!,"Select (1-"_CNT_") to edit an existing race, or RETURN to continue: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
- I X="" S CNT=0 K SRACE D HDR Q
- I '$D(SRACE(X)) W !!,"Enter the number corresponding to the race you want to edit, or RETURN",!,"to continue listing." G SEL
- S SRORAC=$P(SRACE(X),"^",3)
- Q
- HDR ; print screen header
- I '$D(SRHDR) D SRHDR^SRTPUTL
- W @IOF,!,SRHDR W:$G(SRPAGE)'="" ?(79-$L(SRPAGE)),SRPAGE
- S I=0 F S I=$O(SRHDR(I)) Q:'I W !,SRHDR(I) I I=1,$L($G(SRHPG)) W ?(79-$L(SRHPG)),SRHPG
- K SRHPG,SRPAGE W ! F I=1:1:80 W "-"
- W !
- Q
- EDIT ; edit one race
- D HDR W ! S DA=SRORAC,DIE="^SRT("_SRTPP_",44,",DA(1)=SRTPP,DR=".01T" D ^DIE K DR,DIE
- Q
- ASK W !!,"There are no race data entered for this donor. Do you want to add",!,"a new race ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRYN="N"
- S:SRYN="" SRYN="Y"
- S SRYN=$E(SRYN) I "YyNn"'[SRYN W !!,"Enter 'YES' to add another race, or 'NO' to return to the",!,"previous screen." G ASK
- I "Nn"[SRYN S SRSOUT=1 Q
- NEW D HDR W ! K DIR,DA S DIR(0)="139.544,.01",DIR("A")="Donor Race" D ^DIR I Y=""!$D(DTOUT)!$D(DUOUT) Q
- I $D(^SRT(SRTPP,44,"B",Y)) W $C(7)," ??" Q
- I '$D(^SRT(SRTPP,44,0)) S ^SRT(SRTPP,44,0)="^139.544SA^^"
- K DA,DIC,DD,DO,DINUM S DA(1)=SRTPP,X=Y,DIC="^SRT("_SRTPP_",44,",DIC(0)="L" D FILE^DICN K DA,DIC,DD,DO,DINUM
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRTPRACE 2650 printed Mar 13, 2025@21:53:51 Page 2
- SRTPRACE ;BIR/SJA - RACE INFORMATION ;03/27/08
- +1 ;;3.0; Surgery ;**167**;24 Jun 93;Build 27
- +2 NEW RAC,I,SRY,CNT,SRPAGE,SRYN
- SET $PIECE(SRLINE,"-",80)=""
- +3 SET SRSOUT=0
- IF '$DATA(SRTPP)
- WRITE @IOF,!!,"A transplant assessment must be selected prior to using this option.",!!,"Press RETURN to continue "
- READ X:DTIME
- SET SRSOUT=1
- GOTO END
- START SET SRPAGE="RACE INFORMATION"
- DO HDR
- +1 KILL SRORAC
- SET (RAC,CNT)=0
- FOR
- SET RAC=$ORDER(^SRT(SRTPP,44,RAC))
- if 'RAC!($DATA(SRORAC))
- QUIT
- if SRSOUT
- QUIT
- SET CNT=CNT+1
- DO LIST
- IF CNT=13
- WRITE !!,SRLINE
- DO SEL
- +2 IF SRSOUT
- QUIT
- +3 IF $DATA(SRORAC)
- DO EDIT
- GOTO START
- +4 IF CNT
- WRITE !!,SRLINE
- +5 IF CNT=0
- DO ASK
- if 'SRSOUT
- GOTO START
- SET SRSOUT=0
- QUIT
- OPT WRITE !!,"Enter "_$SELECT(CNT=1:1,1:"(1-"_CNT_")")_" to edit an existing race, or 'NEW' to enter another race code: "
- READ X:DTIME
- IF '$TEST!("^"[X)
- QUIT
- +1 IF "Nn"[$EXTRACT(X)
- DO NEW
- GOTO START
- +2 IF '$DATA(SRACE(X))
- WRITE !!,"Select the number corresponding to the race you want to edit, or 'NEW' to",!,"enter an additional race information."
- GOTO OPT
- +3 SET SRORAC=$PIECE(SRACE(X),"^",3)
- DO EDIT
- GOTO START
- +4 QUIT
- END IF 'SRSOUT
- WRITE !!,"Press RETURN to continue "
- READ X:DTIME
- +1 DO ^SRSKILL
- WRITE @IOF
- +2 QUIT
- LIST ; list existing race
- +1 KILL SRY
- SET DIC="^SRT("
- SET DR=44
- SET DA=SRTPP
- SET DR(139.544)=".01"
- SET DA(139.544)=RAC
- SET DIQ="SRY"
- SET DIQ(0)="E"
- DO EN^DIQ1
- +2 SET SRACE(CNT)=$GET(^SRT(SRTPP,44,RAC,0))_"^"_$GET(SRY(139.544,RAC,.01,"E"))_"^"_RAC
- +3 WRITE !,$SELECT(CNT<10:" ",1:"")_CNT_". "_$PIECE(SRACE(CNT),"^",2)
- +4 QUIT
- SEL ; select race
- +1 WRITE !!,"Select (1-"_CNT_") to edit an existing race, or RETURN to continue: "
- READ X:DTIME
- IF '$TEST!(X["^")
- SET SRSOUT=1
- QUIT
- +2 IF X=""
- SET CNT=0
- KILL SRACE
- DO HDR
- QUIT
- +3 IF '$DATA(SRACE(X))
- WRITE !!,"Enter the number corresponding to the race you want to edit, or RETURN",!,"to continue listing."
- GOTO SEL
- +4 SET SRORAC=$PIECE(SRACE(X),"^",3)
- +5 QUIT
- HDR ; print screen header
- +1 IF '$DATA(SRHDR)
- DO SRHDR^SRTPUTL
- +2 WRITE @IOF,!,SRHDR
- if $GET(SRPAGE)'=""
- WRITE ?(79-$LENGTH(SRPAGE)),SRPAGE
- +3 SET I=0
- FOR
- SET I=$ORDER(SRHDR(I))
- if 'I
- QUIT
- WRITE !,SRHDR(I)
- IF I=1
- IF $LENGTH($GET(SRHPG))
- WRITE ?(79-$LENGTH(SRHPG)),SRHPG
- +4 KILL SRHPG,SRPAGE
- WRITE !
- FOR I=1:1:80
- WRITE "-"
- +5 WRITE !
- +6 QUIT
- EDIT ; edit one race
- +1 DO HDR
- WRITE !
- SET DA=SRORAC
- SET DIE="^SRT("_SRTPP_",44,"
- SET DA(1)=SRTPP
- SET DR=".01T"
- DO ^DIE
- KILL DR,DIE
- +2 QUIT
- ASK WRITE !!,"There are no race data entered for this donor. Do you want to add",!,"a new race ? YES// "
- READ SRYN:DTIME
- IF '$TEST!(SRYN["^")
- SET SRYN="N"
- +1 if SRYN=""
- SET SRYN="Y"
- +2 SET SRYN=$EXTRACT(SRYN)
- IF "YyNn"'[SRYN
- WRITE !!,"Enter 'YES' to add another race, or 'NO' to return to the",!,"previous screen."
- GOTO ASK
- +3 IF "Nn"[SRYN
- SET SRSOUT=1
- QUIT
- NEW DO HDR
- WRITE !
- KILL DIR,DA
- SET DIR(0)="139.544,.01"
- SET DIR("A")="Donor Race"
- DO ^DIR
- IF Y=""!$DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- +1 IF $DATA(^SRT(SRTPP,44,"B",Y))
- WRITE $CHAR(7)," ??"
- QUIT
- +2 IF '$DATA(^SRT(SRTPP,44,0))
- SET ^SRT(SRTPP,44,0)="^139.544SA^^"
- +3 KILL DA,DIC,DD,DO,DINUM
- SET DA(1)=SRTPP
- SET X=Y
- SET DIC="^SRT("_SRTPP_",44,"
- SET DIC(0)="L"
- DO FILE^DICN
- KILL DA,DIC,DD,DO,DINUM
- +4 QUIT
