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 Oct 16, 2024@18:48:13 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
