- SRSWL ;B'HAM ISC/MAM - PRINT WAITING LIST; 3 Feb 1989 1:38 PM
- ;;3.0; Surgery ;;24 Jun 93
- Q:'$D(SRSERV) S SRTS="" I SRSERV'="" S SRTS=$O(^SRO(137.45,"B",SRSERV,0)),SRTS=$P(^SRO(137.45,SRTS,0),"^")
- S (SR,SRHDR,Z)=0 D HDR S (SRSWDT,SRSDPT,SROP)=0 F S SRSWDT=$O(^SRO(133.8,"AWL",SRSERV,SRSWDT)) Q:SRSWDT'>0!SR F S SRSDPT=$O(^SRO(133.8,"AWL",SRSERV,SRSWDT,SRSDPT)) Q:SRSDPT="" Q:SR D MORE
- I $D(SRSDEL),'$D(MM) D NUM S:'$D(MM) SR=1
- END K IO("Q"),OPT
- Q
- LOOP ; break procedure if greater than 50 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)'<50 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
- Q
- MORE F S SROP=$O(^SRO(133.8,"AWL",SRSERV,SRSWDT,SRSDPT,SROP)) Q:SROP=""!SR!$D(MM) S SRSDA(1)=^(SROP) D SET
- Q
- HDR W @IOF,!,?10,"Surgery Waiting List" W:SRTS'="" " "_SRTS W !!,"Date Entered",?14,"Patient",?29,"Procedure",! F I=1:1:80 W "-"
- Q
- SET ;
- I $Y+13>IOSL D PAGE G:ZZ="^" END
- D:SRHDR HDR S SRHDR=0
- S Z=Z+1,SRW(Z)=SRSERV_"^"_SRSWDT_"^"_SRSDPT_"^"_SROP_"^"_SRSDA(1),DFN=SRSDPT D DEM^VADPT S SRSDFN=VADM(1) I $L(SRSDFN)>16 S SRSDFN=$P(SRSDFN,",")_", "_$E($P(SRSDFN,",",2))
- K SROPS,MM,MMM S SROPER=SROP S:$L(SROPER)<50 SROPS(1)=SROPER I $L(SROPER)>49 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
- W !,Z_".",?3,$E(SRSWDT,4,5)_"/"_$E(SRSWDT,6,7)_"/"_$E(SRSWDT,2,3),?12,SRSDFN,?29,SROPS(1) I $D(SROPS(2)) W !,?29,SROPS(2)
- W ! F I=1:1:80 W "-"
- Q
- PAGE ;
- I '$D(SRSDEL) W !!,"Press RETURN to continue, or '^' to stop the list " R ZZ:DTIME S:'$T ZZ="^" S:ZZ="^" SR=1 S SRHDR=1 Q
- NUM Q:SR W !!,"Select a number, or press RETURN to continue: " R ZZ:DTIME S:'$T ZZ="^" S:ZZ="^" SR=1 Q:ZZ="^"
- I ZZ="" S SRHDR=1 Q
- I 'ZZ!'$D(SRW(ZZ)) W !!,"Enter the number corresponding to the patient that you want to "_$S(SRSDEL:"delete",1:"edit")_", or",!,"press RETURN to continue. Entering a '^' will exit you from this option." G PAGE
- S MM=ZZ,ZZ="^",SR=0
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSWL 1940 printed Feb 19, 2025@00:14:23 Page 2
- SRSWL ;B'HAM ISC/MAM - PRINT WAITING LIST; 3 Feb 1989 1:38 PM
- +1 ;;3.0; Surgery ;;24 Jun 93
- +2 if '$DATA(SRSERV)
- QUIT
- SET SRTS=""
- IF SRSERV'=""
- SET SRTS=$ORDER(^SRO(137.45,"B",SRSERV,0))
- SET SRTS=$PIECE(^SRO(137.45,SRTS,0),"^")
- +3 SET (SR,SRHDR,Z)=0
- DO HDR
- SET (SRSWDT,SRSDPT,SROP)=0
- FOR
- SET SRSWDT=$ORDER(^SRO(133.8,"AWL",SRSERV,SRSWDT))
- if SRSWDT'>0!SR
- QUIT
- FOR
- SET SRSDPT=$ORDER(^SRO(133.8,"AWL",SRSERV,SRSWDT,SRSDPT))
- if SRSDPT=""
- QUIT
- if SR
- QUIT
- DO MORE
- +4 IF $DATA(SRSDEL)
- IF '$DATA(MM)
- DO NUM
- if '$DATA(MM)
- SET SR=1
- END KILL IO("Q"),OPT
- +1 QUIT
- LOOP ; break procedure if greater than 50 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)'<50
- QUIT
- SET SROPS(M)=SROPS(M)_MM_" "
- SET SROPER=MMM
- +2 QUIT
- MORE FOR
- SET SROP=$ORDER(^SRO(133.8,"AWL",SRSERV,SRSWDT,SRSDPT,SROP))
- if SROP=""!SR!$DATA(MM)
- QUIT
- SET SRSDA(1)=^(SROP)
- DO SET
- +1 QUIT
- HDR WRITE @IOF,!,?10,"Surgery Waiting List"
- if SRTS'=""
- WRITE " "_SRTS
- WRITE !!,"Date Entered",?14,"Patient",?29,"Procedure",!
- FOR I=1:1:80
- WRITE "-"
- +1 QUIT
- SET ;
- +1 IF $Y+13>IOSL
- DO PAGE
- if ZZ="^"
- GOTO END
- +2 if SRHDR
- DO HDR
- SET SRHDR=0
- +3 SET Z=Z+1
- SET SRW(Z)=SRSERV_"^"_SRSWDT_"^"_SRSDPT_"^"_SROP_"^"_SRSDA(1)
- SET DFN=SRSDPT
- DO DEM^VADPT
- SET SRSDFN=VADM(1)
- IF $LENGTH(SRSDFN)>16
- SET SRSDFN=$PIECE(SRSDFN,",")_", "_$EXTRACT($PIECE(SRSDFN,",",2))
- +4 KILL SROPS,MM,MMM
- SET SROPER=SROP
- if $LENGTH(SROPER)<50
- SET SROPS(1)=SROPER
- IF $LENGTH(SROPER)>49
- SET SROPER=SROPER_" "
- FOR M=1:1
- DO LOOP
- if MMM=""
- QUIT
- +5 WRITE !,Z_".",?3,$EXTRACT(SRSWDT,4,5)_"/"_$EXTRACT(SRSWDT,6,7)_"/"_$EXTRACT(SRSWDT,2,3),?12,SRSDFN,?29,SROPS(1)
- IF $DATA(SROPS(2))
- WRITE !,?29,SROPS(2)
- +6 WRITE !
- FOR I=1:1:80
- WRITE "-"
- +7 QUIT
- PAGE ;
- +1 IF '$DATA(SRSDEL)
- WRITE !!,"Press RETURN to continue, or '^' to stop the list "
- READ ZZ:DTIME
- if '$TEST
- SET ZZ="^"
- if ZZ="^"
- SET SR=1
- SET SRHDR=1
- QUIT
- NUM if SR
- QUIT
- WRITE !!,"Select a number, or press RETURN to continue: "
- READ ZZ:DTIME
- if '$TEST
- SET ZZ="^"
- if ZZ="^"
- SET SR=1
- if ZZ="^"
- QUIT
- +1 IF ZZ=""
- SET SRHDR=1
- QUIT
- +2 IF 'ZZ!'$DATA(SRW(ZZ))
- WRITE !!,"Enter the number corresponding to the patient that you want to "_$SELECT(SRSDEL:"delete",1:"edit")_", or",!,"press RETURN to continue. Entering a '^' will exit you from this option."
- GOTO PAGE
- +3 SET MM=ZZ
- SET ZZ="^"
- SET SR=0
- +4 QUIT