- SRSMREQ ;B'HAM ISC/MAM - MAKE OPERATION REQUESTS; [ 01/08/98 9:54 AM ]
- ;;3.0; Surgery ;**37,68,77**;24 Jun 93
- S (SRSOUT,SRWL)=0 I $D(ORVP) S (DFN,SRSDPT)=+ORVP G DEAD
- PAT W ! S DIC=2,DIC(0)="QEAMZ",DIC("A")="Select Patient: " D ^DIC K DIC I Y<0 S SRSOUT=1 G END
- S (SRSDPT,DFN)=+Y
- DEAD D DEM^VADPT S SRNM=VADM(1),SRSSN=VA("PID")
- I $D(^DPT(SRSDPT,.35)),$P(^(.35),"^")'="" S Y=$E($P(^(.35),"^"),1,7) D D^DIQ W !!,"The records show that "_SRNM_" died on "_Y_".",! G:$D(ORVP) END G PAT
- S SRSOTH=0 D LFTOVR^SRSREQUT
- G:SRSOTH=1 END
- DATE W ! S P(3)="",%DT="AEFX",%DT("A")="Make a Request for which Date ? " D ^%DT G:Y<0 END I Y<DT W !!,"Requests cannot be made for past dates. ",! G DATE
- S SRSDATE=Y D D^DIQ S SREQDT=Y,ST="REQUESTS",SRSOP="",SRSDAY=P(3),SRSST=0
- K SRLATE D LATE^SRSREQ I $D(SRLATE) G DATE
- S SRSC="" D CONCUR^SRSREQ G:SRSC=0 END W !
- I $G(SRSC)=1 S SRSCON=2,SRCC=1 D CON^SRSRQST G R2^SRSCONR
- I $D(ORNP),$D(^VA(200,ORNP,0)) S DIR("B")=$P(^VA(200,ORNP,0),"^")
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSMREQ 1126 printed Feb 19, 2025@00:14:03 Page 2
- SRSMREQ ;B'HAM ISC/MAM - MAKE OPERATION REQUESTS; [ 01/08/98 9:54 AM ]
- +1 ;;3.0; Surgery ;**37,68,77**;24 Jun 93
- +2 SET (SRSOUT,SRWL)=0
- IF $DATA(ORVP)
- SET (DFN,SRSDPT)=+ORVP
- GOTO DEAD
- PAT WRITE !
- SET DIC=2
- SET DIC(0)="QEAMZ"
- SET DIC("A")="Select Patient: "
- DO ^DIC
- KILL DIC
- IF Y<0
- SET SRSOUT=1
- GOTO END
- +1 SET (SRSDPT,DFN)=+Y
- DEAD DO DEM^VADPT
- SET SRNM=VADM(1)
- SET SRSSN=VA("PID")
- +1 IF $DATA(^DPT(SRSDPT,.35))
- IF $PIECE(^(.35),"^")'=""
- SET Y=$EXTRACT($PIECE(^(.35),"^"),1,7)
- DO D^DIQ
- WRITE !!,"The records show that "_SRNM_" died on "_Y_".",!
- if $DATA(ORVP)
- GOTO END
- GOTO PAT
- +2 SET SRSOTH=0
- DO LFTOVR^SRSREQUT
- +3 if SRSOTH=1
- GOTO END
- DATE WRITE !
- SET P(3)=""
- SET %DT="AEFX"
- SET %DT("A")="Make a Request for which Date ? "
- DO ^%DT
- if Y<0
- GOTO END
- IF Y<DT
- WRITE !!,"Requests cannot be made for past dates. ",!
- GOTO DATE
- +1 SET SRSDATE=Y
- DO D^DIQ
- SET SREQDT=Y
- SET ST="REQUESTS"
- SET SRSOP=""
- SET SRSDAY=P(3)
- SET SRSST=0
- +2 KILL SRLATE
- DO LATE^SRSREQ
- IF $DATA(SRLATE)
- GOTO DATE
- +3 SET SRSC=""
- DO CONCUR^SRSREQ
- if SRSC=0
- GOTO END
- WRITE !
- +4 IF $GET(SRSC)=1
- SET SRSCON=2
- SET SRCC=1
- DO CON^SRSRQST
- GOTO R2^SRSCONR
- +5 IF $DATA(ORNP)
- IF $DATA(^VA(200,ORNP,0))
- SET DIR("B")=$PIECE(^VA(200,ORNP,0),"^")
- +6 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