SRSWL5.m

SRSWL5 ;B'HAM ISC/MAM - PRINT PROCEDURE FOR WAITING LIST ; 20 SEPT 1990  9:00 AM

 ;;3.0; Surgery ;;24 Jun 93

 S SROLD=0 D OLD^SRSWLST Q:'SROLD  S SROPER=$P(^SRF(SROLD,"OP"),"^")

 K SROPS,MM,MMM S:$L(SROPER)<70 SROPS(1)=SROPER I $L(SROPER)>69 S SROPER=SROPER_"  " F M=1:1 D LOOP Q:MMM=""

 W !,"* Procedure performed since this entry was made on the Waiting List",!,"  Operation Date: "_SROLD("DATE"),!,?2,SROPS(1) I $D(SROPS(2)) W !,?2,SROPS(2)

 Q

LOOP ; break operation if greater than 69 characters

 S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM=""  Q:$L(SROPS(M))+$L(MM)'<70  S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SRSWL5   658     printed  Apr 09, 2024@21:40:52                                                                                                                                                                                                       Page 2

SRSWL5    ;B'HAM ISC/MAM - PRINT PROCEDURE FOR WAITING LIST ; 20 SEPT 1990  9:00 AM

 +1       ;;3.0; Surgery ;;24 Jun 93

 +2        SET SROLD=0

           DO OLD^SRSWLST

           if 'SROLD

               QUIT 

           SET SROPER=$PIECE(^SRF(SROLD,"OP"),"^")

 +3        KILL SROPS,MM,MMM

           if $LENGTH(SROPER)<70

               SET SROPS(1)=SROPER

           IF $LENGTH(SROPER)>69

               SET SROPER=SROPER_"  "

               FOR M=1:1

                   DO LOOP

                   if MMM=""

                       QUIT 

 +4        WRITE !,"* Procedure performed since this entry was made on the Waiting List",!,"  Operation Date: "_SROLD("DATE"),!,?2,SROPS(1)

           IF $DATA(SROPS(2))

               WRITE !,?2,SROPS(2)

 +5        QUIT 

LOOP      ; break operation if greater than 69 characters

 +1        SET SROPS(M)=""

           FOR LOOP=1:1

               SET MM=$PIECE(SROPER," ")

               SET MMM=$PIECE(SROPER," ",2,200)

               if MMM=""

                   QUIT 

               if $LENGTH(SROPS(M))+$LENGTH(MM)'<70

                   QUIT 

               SET SROPS(M)=SROPS(M)_MM_" "

               SET SROPER=MMM

 +2        QUIT