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 Oct 16, 2024@18:46 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
