SRSCHK ;B'HAM ISC/MAM - CHECK FOR REQUIRED FIELDS ; 27 DEC 1991 12:30 PM
;;3.0; Surgery ;;24 Jun 93
K NOWAY I '$O(^SRO(133,SRSITE,4,0)) Q
S (SRFIELD,CNT)=0 F S SRFIELD=$O(^SRO(133,SRSITE,4,SRFIELD)) Q:'SRFIELD S FIELD=$P(^SRO(133,SRSITE,4,SRFIELD,0),"^") D CHECK
I $D(NOWAY) W !!,"This case cannot be scheduled until the missing information has been entered.",!!,"Press RETURN to continue " R X:DTIME
Q
CHECK ; check each field for data
S FNAME=$P(^DD(130,FIELD,0),"^"),GLOBAL=$P(^DD(130,FIELD,0),"^",4),Y=$P(GLOBAL,";",2) I Y=0 D MULT Q
S SUB=$P(GLOBAL,";"),PIECE=$P(GLOBAL,";",2) I $P($G(^SRF(SRTN,SUB)),"^",PIECE)="" S CNT=CNT+1 W:CNT=1 ! W !,"The field '"_FNAME_"' has not been entered." S NOWAY=1
Q
MULT ; check multiple
S SUB=$P(GLOBAL,";") I '$O(^SRF(SRTN,SUB,0)) S CNT=CNT+1 W:CNT=1 ! W !,"The field '"_FNAME_"' has not been entered." S NOWAY=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSCHK 882 printed Dec 13, 2024@02:47:16 Page 2
SRSCHK ;B'HAM ISC/MAM - CHECK FOR REQUIRED FIELDS ; 27 DEC 1991 12:30 PM
+1 ;;3.0; Surgery ;;24 Jun 93
+2 KILL NOWAY
IF '$ORDER(^SRO(133,SRSITE,4,0))
QUIT
+3 SET (SRFIELD,CNT)=0
FOR
SET SRFIELD=$ORDER(^SRO(133,SRSITE,4,SRFIELD))
if 'SRFIELD
QUIT
SET FIELD=$PIECE(^SRO(133,SRSITE,4,SRFIELD,0),"^")
DO CHECK
+4 IF $DATA(NOWAY)
WRITE !!,"This case cannot be scheduled until the missing information has been entered.",!!,"Press RETURN to continue "
READ X:DTIME
+5 QUIT
CHECK ; check each field for data
+1 SET FNAME=$PIECE(^DD(130,FIELD,0),"^")
SET GLOBAL=$PIECE(^DD(130,FIELD,0),"^",4)
SET Y=$PIECE(GLOBAL,";",2)
IF Y=0
DO MULT
QUIT
+2 SET SUB=$PIECE(GLOBAL,";")
SET PIECE=$PIECE(GLOBAL,";",2)
IF $PIECE($GET(^SRF(SRTN,SUB)),"^",PIECE)=""
SET CNT=CNT+1
if CNT=1
WRITE !
WRITE !,"The field '"_FNAME_"' has not been entered."
SET NOWAY=1
+3 QUIT
MULT ; check multiple
+1 SET SUB=$PIECE(GLOBAL,";")
IF '$ORDER(^SRF(SRTN,SUB,0))
SET CNT=CNT+1
if CNT=1
WRITE !
WRITE !,"The field '"_FNAME_"' has not been entered."
SET NOWAY=1
+2 QUIT
