SRSMREQ.m

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

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