SROPSEL.m

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 ---SROPSEL   811     printed  Apr 09, 2024@21:48:30                                                                                                                                                                                                      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