- SROPSEL ;B'HAM ISC/MAM - SELECT CASE ; [ 01/10/04 2:22 PM ]
- ;;3.0; Surgery ;**121,125**;24 Jun 93
- D ID Q:SRSOUT=1
- S DFN=+Y D DEM^VADPT
- Q
- ID S SRNOPE=0,SRSEL=1 K DIR
- S DIR("?",1)=" To lookup by patient, enter patient name or patient ID. To lookup by"
- S DIR("?",2)=" surgical case/assessment number, enter the number preceded by ""#"","
- S DIR("?")=" e.g., for case 12345 enter ""#12345"" (no spaces)."
- S DIR("A")="Select Patient: ",DIR(0)="FOA" D ^DIR K DIR
- I $D(DTOUT)!$D(DUOUT)!(Y="") S SRSOUT=1 Q
- I $E(X)="#" S Y=$E(X,2,$L(X)),SRSEL=2 D G:SRNOPE ID Q
- .I 'Y S SRSOUT=1 Q
- .S SROP=Y,Y=$G(^SRF(Y,0)) I '+Y W !!," "_SROP_" is an invalid entry. Please try again." W ! S SRNOPE=1 Q
- K DIC S X=Y,DIC=2,DIC(0)="QEM" D ^DIC K DIC
- G:Y<0 ID I $D(DUOUT)!$D(DIRUT) S SRSOUT=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROPSEL 811 printed Feb 19, 2025@00:11:50 Page 2
- SROPSEL ;B'HAM ISC/MAM - SELECT CASE ; [ 01/10/04 2:22 PM ]
- +1 ;;3.0; Surgery ;**121,125**;24 Jun 93
- +2 DO ID
- if SRSOUT=1
- QUIT
- +3 SET DFN=+Y
- DO DEM^VADPT
- +4 QUIT
- ID SET SRNOPE=0
- SET SRSEL=1
- KILL DIR
- +1 SET DIR("?",1)=" To lookup by patient, enter patient name or patient ID. To lookup by"
- +2 SET DIR("?",2)=" surgical case/assessment number, enter the number preceded by ""#"","
- +3 SET DIR("?")=" e.g., for case 12345 enter ""#12345"" (no spaces)."
- +4 SET DIR("A")="Select Patient: "
- SET DIR(0)="FOA"
- DO ^DIR
- KILL DIR
- +5 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
- SET SRSOUT=1
- QUIT
- +6 IF $EXTRACT(X)="#"
- SET Y=$EXTRACT(X,2,$LENGTH(X))
- SET SRSEL=2
- Begin DoDot:1
- +7 IF 'Y
- SET SRSOUT=1
- QUIT
- +8 SET SROP=Y
- SET Y=$GET(^SRF(Y,0))
- IF '+Y
- WRITE !!," "_SROP_" is an invalid entry. Please try again."
- WRITE !
- SET SRNOPE=1
- QUIT
- End DoDot:1
- if SRNOPE
- GOTO ID
- QUIT
- +9 KILL DIC
- SET X=Y
- SET DIC=2
- SET DIC(0)="QEM"
- DO ^DIC
- KILL DIC
- +10 if Y<0
- GOTO ID
- IF $DATA(DUOUT)!$DATA(DIRUT)
- SET SRSOUT=1
- +11 QUIT