Routine: SRSREQUT

SRSREQUT ;B'HAM ISC/MAM - REQUEST UTILITIES ; 29 SEPT 1992  10:35 am

 ;;3.0; Surgery ;;24 Jun 93

LFTOVR ; check for outstanding requests

 K SRCASE S (CNT,SRSRDT,SRTN)=0 F  S SRSRDT=$O(^SRF("AR",SRSRDT)) Q:'SRSRDT  F  S SRTN=$O(^SRF("AR",SRSRDT,SRSDPT,SRTN)) Q:'SRTN  D COMP I 'SRDONE S CNT=CNT+1,SRCASE(CNT)=SRTN

 Q:'$O(SRCASE(0))  S GRAMMER=$S($D(SRCASE(2)):"requests are",1:"request is") W !!,"The following "_GRAMMER_" outstanding for "_SRNM_":",!

 S CNT=0 F I=0:0 S CNT=$O(SRCASE(CNT)) Q:'CNT  S SRTN=SRCASE(CNT),SRSDT=$P(^SRF(SRTN,0),"^",9),SRSDT=$E(SRSDT,4,5)_"-"_$E(SRSDT,6,7)_"-"_$E(SRSDT,2,3) D LIST

UP W !!,"Do you want to update "_$S(CNT>1:"one of ",1:"")_"the outstanding request"_$S(CNT>1:"s",1:"")_" ?  YES// " R SROUTS:DTIME S:'$T SROUTS="^" Q:SROUTS["^"  S:SROUTS="" SROUTS="Y"

 S SROUTS=$E(SROUTS)

 I "YyNn"'[SROUTS W !!,"Enter a RETURN if you would like to delete, update, or change the date of the",!,"requested cases." G UP

 I "Yy"[SROUTS S SRDFN=SRSDPT,SRSOUT=0 D OPT^SRSUPRQ S (SRSOTH,SRSOUT)=1

NEW Q:SRSOTH  W !!,"Do you want to make a new request for "_SRNM_" ? NO//  " R X:DTIME I '$T!("^"[X) S X="N"

 S X=$E(X) I "YyNn"'[X W !!,"Enter 'YES' to continue with this option to make a new request, or RETURN to",!,"quit." G NEW

 I "Nn"[X S SRSOTH=1

COMP S SRDONE=0 I '$D(^SRF(SRTN,.2)) Q

 I $P(^SRF(SRTN,.2),"^",12)="" Q

 S SRDONE=1 K DIE,DR,DA S DA=SRTN,DIE=130,DR="36///0;Q;.09///"_$P(^SRF(SRTN,0),"^",9) D ^DIE K DR,DIE,DA

LIST ;

 S SRSOP=$P(^SRF(SRTN,"OP"),"^") K SROPS,MM,MMM S:$L(SRSOP)<70 SROPS(1)=SRSOP I $L(SRSOP)>69 S SROPER=SRSOP S SROPER=SROPER_"  " F M=1:1 D LOOP Q:MMM=""

 W !,CNT_".",?5,SRSDT,!,?5,SROPS(1) I $D(SROPS(2)) W !,?5,SROPS(2) I $D(SROPS(3)) W !,?5,SROPS(3) I $D(SROPS(4)) W !,?5,SROPS(4)

LOOP ; break procedure if greater than 70 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)'<70  S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM

SRSREQUT  ;B'HAM ISC/MAM - REQUEST UTILITIES ; 29 SEPT 1992  10:35 am

 +1       ;;3.0; Surgery ;;24 Jun 93

LFTOVR    ; check for outstanding requests

 +1        KILL SRCASE

           SET (CNT,SRSRDT,SRTN)=0

FOR

               SET SRSRDT=$ORDER(^SRF("AR",SRSRDT))

               IF 'SRSRDT

                   QUIT

FOR

                   SET SRTN=$ORDER(^SRF("AR",SRSRDT,SRSDPT,SRTN))

                   IF 'SRTN

                       QUIT

                   DO COMP

                   IF 'SRDONE

                       SET CNT=CNT+1

                       SET SRCASE(CNT)=SRTN

 +2        IF '$ORDER(SRCASE(0))

               QUIT

           SET GRAMMER=$SELECT($DATA(SRCASE(2)):"requests are",1:"request is")

           WRITE !!,"The following "_GRAMMER_" outstanding for "_SRNM_":",!

 +3        SET CNT=0

           FOR I=0:0

               SET CNT=$ORDER(SRCASE(CNT))

               IF 'CNT

                   QUIT

               SET SRTN=SRCASE(CNT)

               SET SRSDT=$PIECE(^SRF(SRTN,0),"^",9)

               SET SRSDT=$EXTRACT(SRSDT,4,5)_"-"_$EXTRACT(SRSDT,6,7)_"-"_$EXTRACT(SRSDT,2,3)

               DO LIST

UP         WRITE !!,"Do you want to update "_$SELECT(CNT>1:"one of ",1:"")_"the outstanding request"_$SELECT(CNT>1:"s",1:"")_" ?  YES// "

           READ SROUTS:DTIME

           IF '$TEST

               SET SROUTS="^"

           IF SROUTS["^"

               QUIT

           IF SROUTS=""

               SET SROUTS="Y"

 +1        SET SROUTS=$EXTRACT(SROUTS)

 +2        IF "YyNn"'[SROUTS

               WRITE !!,"Enter a RETURN if you would like to delete, update, or change the date of the",!,"requested cases."

               GOTO UP

 +3        IF "Yy"[SROUTS

               SET SRDFN=SRSDPT

               SET SRSOUT=0

               DO OPT^SRSUPRQ

               SET (SRSOTH,SRSOUT)=1

NEW        IF SRSOTH

               QUIT

           WRITE !!,"Do you want to make a new request for "_SRNM_" ? NO//  "

           READ X:DTIME

           IF '$TEST!("^"[X)

               SET X="N"

 +1        SET X=$EXTRACT(X)

           IF "YyNn"'[X

               WRITE !!,"Enter 'YES' to continue with this option to make a new request, or RETURN to",!,"quit."

               GOTO NEW

 +2        IF "Nn"[X

               SET SRSOTH=1

 +3        QUIT

COMP       SET SRDONE=0

           IF '$DATA(^SRF(SRTN,.2))

               QUIT

 +1        IF $PIECE(^SRF(SRTN,.2),"^",12)=""

               QUIT

 +2        SET SRDONE=1

           KILL DIE,DR,DA

           SET DA=SRTN

           SET DIE=130

           SET DR="36///0;Q;.09///"_$PIECE(^SRF(SRTN,0),"^",9)

           DO ^DIE

           KILL DR,DIE,DA

 +3        QUIT

LIST      ;

 +1        SET SRSOP=$PIECE(^SRF(SRTN,"OP"),"^")

           KILL SROPS,MM,MMM

           IF $LENGTH(SRSOP)<70

               SET SROPS(1)=SRSOP

           IF $LENGTH(SRSOP)>69

               SET SROPER=SRSOP

               SET SROPER=SROPER_"  "

               FOR M=1:1

                   DO LOOP

                   IF MMM=""

                       QUIT

 +2        WRITE !,CNT_".",?5,SRSDT,!,?5,SROPS(1)

           IF $DATA(SROPS(2))

               WRITE !,?5,SROPS(2)

               IF $DATA(SROPS(3))

                   WRITE !,?5,SROPS(3)

                   IF $DATA(SROPS(4))

                       WRITE !,?5,SROPS(4)

 +3        QUIT

LOOP      ; break procedure if greater than 70 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)'<70

                   QUIT

               SET SROPS(M)=SROPS(M)_MM_" "

               SET SROPER=MMM

 +2        QUIT

SRSREQUT.m