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
Q
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
Q
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)
Q
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSREQUT 1972 printed Oct 16, 2024@18:48:21 Page 2
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
