- SRSWREQ ;BIR/MAM - REQUEST FROM WAITING LIST ;08/11/05
- ;;3.0; Surgery ;**58,77,105,146**;24 Jun 93
- S SRWL=1,SRSOUT=0 I $D(ORVP) S (DFN,SRSDPT)=+ORVP G DEAD
- W @IOF,! K DIC S DIC=2,DIC(0)="QEAMZ",DIC("A")="Make a request from the waiting list for which patient ? " D ^DIC K DIC I Y<0 S SRSOUT=1 G END
- S (DFN,SRSDPT)=+Y
- DEAD D DEM^VADPT S SRNM=VADM(1),SRSSN=VA("PID")
- I $D(^DPT(DFN,.35)),$P(^(.35),"^")'="" S Y=$E($P(^(.35),"^"),1,7) D D^DIQ W !!,"The records show that "_SRNM_" died on "_Y_".",! G END
- I '$O(^SRO(133.8,"AP",DFN,0)) W !!,"There are no entries on the Waiting List for "_SRNM_"." G END
- LIST W @IOF,!,"Procedures Entered on the Waiting List for "_SRNM_": ",!! K SRW S (CNT,SRSS)=0
- F S SRSS=$O(^SRO(133.8,"AP",DFN,SRSS)) Q:'SRSS S SROFN=0 F S SROFN=$O(^SRO(133.8,"AP",DFN,SRSS,SROFN)) Q:'SROFN D ARRAY
- I '$D(SRW(2)) S SRW=1 D OK G:"Yy"[SRYN REQ S SRSOUT=1 G END
- W !!!,"Select Number: " R SRW:DTIME I '$T!("^"[SRW) S SRSOUT=1 G END
- I '$D(SRW(SRW)) W !!,"Select the number corresponding to the entry for which the request will",!,"be made.",!!,"Press RETURN to continue " R X:DTIME G LIST
- REQ S SRSOTH=0
- D LFTOVR^SRSREQUT I SRSOTH S SRSOUT=1 G END
- DATE W ! K %DT S %DT="AEFX",%DT("A")="Make a request for which Date ? " D ^%DT I Y<0 S SRSOUT=1 G END
- S SRSDATE=+Y,SRSST=0 I SRSDATE<DT W !!,"Requests cannot be made for past dates.",!!,"Press RETURN to continue " G DATE
- D D^DIQ S SREQDT=Y
- K SRLATE D LATE^SRSREQ I $D(SRLATE) G DATE
- S SRSS=$P(SRW(SRW),"^"),SRSOP=$P(SRW(SRW),"^",5) F SRI=6:1:12 S SRCL(SRI+10)=$P(SRW(SRW),"^",SRI)
- K DIR I $D(ORNP) S DIR("B")=$P(^VA(200,ORNP,0),"^")
- S ST="REQUEST"
- D ^SRSRQST
- END I 'SRSOUT W ! K DIR S DIR(0)="FOA",DIR("A")="Press RETURN to continue: " D ^DIR
- K SRTN D ^SRSKILL W @IOF
- Q
- ARRAY ; set array for waiting list info
- S CNT=CNT+1,SRSER=$P(^SRO(133.8,SRSS,0),"^"),SRSERV=$P(^SRO(137.45,SRSER,0),"^")
- S SROPER=$P(^SRO(133.8,SRSS,1,SROFN,0),"^",2),Y=$P(^(0),"^",3) D D^DIQ S SRDT=$E(Y,1,12),SRW(CNT)=SRSER_"^"_SROFN_"^"_SRSERV_"^"_SRDT_"^"_SROPER_"^"_$P(^SRO(133.8,SRSS,1,SROFN,0),"^",16,22)
- W !,CNT_". "_SRSERV,?40,"Date Entered on List: "_SRDT,!,?3,SROPER,!
- Q
- OK W !!,"Is this the correct procedure ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRYN="N" Q
- S SRYN=$E(SRYN) S:SRYN="" SRYN="Y" I "YyNn"'[SRYN W !!,"Enter RETURN if this is the procedure that you would like to make into a",!,"request. Otherwise, enter 'NO'." G OK
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSWREQ 2443 printed Feb 19, 2025@00:14:39 Page 2
- SRSWREQ ;BIR/MAM - REQUEST FROM WAITING LIST ;08/11/05
- +1 ;;3.0; Surgery ;**58,77,105,146**;24 Jun 93
- +2 SET SRWL=1
- SET SRSOUT=0
- IF $DATA(ORVP)
- SET (DFN,SRSDPT)=+ORVP
- GOTO DEAD
- +3 WRITE @IOF,!
- KILL DIC
- SET DIC=2
- SET DIC(0)="QEAMZ"
- SET DIC("A")="Make a request from the waiting list for which patient ? "
- DO ^DIC
- KILL DIC
- IF Y<0
- SET SRSOUT=1
- GOTO END
- +4 SET (DFN,SRSDPT)=+Y
- DEAD DO DEM^VADPT
- SET SRNM=VADM(1)
- SET SRSSN=VA("PID")
- +1 IF $DATA(^DPT(DFN,.35))
- IF $PIECE(^(.35),"^")'=""
- SET Y=$EXTRACT($PIECE(^(.35),"^"),1,7)
- DO D^DIQ
- WRITE !!,"The records show that "_SRNM_" died on "_Y_".",!
- GOTO END
- +2 IF '$ORDER(^SRO(133.8,"AP",DFN,0))
- WRITE !!,"There are no entries on the Waiting List for "_SRNM_"."
- GOTO END
- LIST WRITE @IOF,!,"Procedures Entered on the Waiting List for "_SRNM_": ",!!
- KILL SRW
- SET (CNT,SRSS)=0
- +1 FOR
- SET SRSS=$ORDER(^SRO(133.8,"AP",DFN,SRSS))
- if 'SRSS
- QUIT
- SET SROFN=0
- FOR
- SET SROFN=$ORDER(^SRO(133.8,"AP",DFN,SRSS,SROFN))
- if 'SROFN
- QUIT
- DO ARRAY
- +2 IF '$DATA(SRW(2))
- SET SRW=1
- DO OK
- if "Yy"[SRYN
- GOTO REQ
- SET SRSOUT=1
- GOTO END
- +3 WRITE !!!,"Select Number: "
- READ SRW:DTIME
- IF '$TEST!("^"[SRW)
- SET SRSOUT=1
- GOTO END
- +4 IF '$DATA(SRW(SRW))
- WRITE !!,"Select the number corresponding to the entry for which the request will",!,"be made.",!!,"Press RETURN to continue "
- READ X:DTIME
- GOTO LIST
- REQ SET SRSOTH=0
- +1 DO LFTOVR^SRSREQUT
- IF SRSOTH
- SET SRSOUT=1
- GOTO END
- DATE WRITE !
- KILL %DT
- SET %DT="AEFX"
- SET %DT("A")="Make a request for which Date ? "
- DO ^%DT
- IF Y<0
- SET SRSOUT=1
- GOTO END
- +1 SET SRSDATE=+Y
- SET SRSST=0
- IF SRSDATE<DT
- WRITE !!,"Requests cannot be made for past dates.",!!,"Press RETURN to continue "
- GOTO DATE
- +2 DO D^DIQ
- SET SREQDT=Y
- +3 KILL SRLATE
- DO LATE^SRSREQ
- IF $DATA(SRLATE)
- GOTO DATE
- +4 SET SRSS=$PIECE(SRW(SRW),"^")
- SET SRSOP=$PIECE(SRW(SRW),"^",5)
- FOR SRI=6:1:12
- SET SRCL(SRI+10)=$PIECE(SRW(SRW),"^",SRI)
- +5 KILL DIR
- IF $DATA(ORNP)
- SET DIR("B")=$PIECE(^VA(200,ORNP,0),"^")
- +6 SET ST="REQUEST"
- +7 DO ^SRSRQST
- END IF 'SRSOUT
- WRITE !
- KILL DIR
- SET DIR(0)="FOA"
- SET DIR("A")="Press RETURN to continue: "
- DO ^DIR
- +1 KILL SRTN
- DO ^SRSKILL
- WRITE @IOF
- +2 QUIT
- ARRAY ; set array for waiting list info
- +1 SET CNT=CNT+1
- SET SRSER=$PIECE(^SRO(133.8,SRSS,0),"^")
- SET SRSERV=$PIECE(^SRO(137.45,SRSER,0),"^")
- +2 SET SROPER=$PIECE(^SRO(133.8,SRSS,1,SROFN,0),"^",2)
- SET Y=$PIECE(^(0),"^",3)
- DO D^DIQ
- SET SRDT=$EXTRACT(Y,1,12)
- SET SRW(CNT)=SRSER_"^"_SROFN_"^"_SRSERV_"^"_SRDT_"^"_SROPER_"^"_$PIECE(^SRO(133.8,SRSS,1,SROFN,0),"^",16,22)
- +3 WRITE !,CNT_". "_SRSERV,?40,"Date Entered on List: "_SRDT,!,?3,SROPER,!
- +4 QUIT
- OK WRITE !!,"Is this the correct procedure ? YES// "
- READ SRYN:DTIME
- IF '$TEST!(SRYN["^")
- SET SRYN="N"
- QUIT
- +1 SET SRYN=$EXTRACT(SRYN)
- if SRYN=""
- SET SRYN="Y"
- IF "YyNn"'[SRYN
- WRITE !!,"Enter RETURN if this is the procedure that you would like to make into a",!,"request. Otherwise, enter 'NO'."
- GOTO OK
- +2 QUIT