SCUTBK ;ALB/MJK - Scheduling Broker Utilities ;[ 03/21/95 4:13 PM ]
;;5.3;Scheduling;**41,130**;AUG 13, 1993
;
Q
;
CHK ; -- all broker callbacks pass thru here
Q
;
LISTC(SCDATA,SC) ; -- broker callback to get list data
N SCFILE,SCIENS,SCFIELDS,SCMAX,SCFROM,SCPART,SCXREF,SCREEN,SCID,SCVAL,SCROOT,SCERR,SCRSLT,SCFLD
D CHK
; -- parse array to parameters
D PARSE(.SC)
S SCFLAGS=$G(SCFLAGS)_"PS"
;
; -- get specific field criteria - screen code (below) left as reminder
;IF $G(SC("DDFILE")),$G(SC("DDFIELD")),$D(^DD(SC("DDFILE"),SC("DDFIELD"),12.1)) D
;. N DIC X ^(12.1) S:$D(DIC("S")) SCREEN=DIC("S")
;
; -- need to get from kernel broker somehow...
D TMP
;
D LIST^DIC(SCFILE,SCIENS,SCFIELDS,SCFLAGS,SCMAX,.SCFROM,SCPART,SCXREF,SCREEN,SCID,"^TMP(""SCRSLT"",$J)","SCERR")
;
N Y,I,N
;
S N=0
IF $G(SCFROM)]"" D
. D SET("[Misc]")
. D SET("MORE"_U_SCFROM_U_SCFROM("IEN"))
;
D SET("[Data]")
S I=0 F S I=$O(^TMP("SCRSLT",$J,"DILIST",I)) Q:'I D SET(^TMP("SCRSLT",$J,"DILIST",I,0))
;
IF $D(SCERR) D
. D SET("[Errors]")
;
M SCDATA=Y
Q
;
SET(X) ;
S N=N+1
S Y(N)=X
Q
;
PARSE(SC) ; -- array parsing
S SCFILE=$G(SC("FILE"))
S SCIENS=$G(SC("IENS"))
S SCFIELDS=$G(SC("FIELDS"))
S SCFLAGS=$G(SC("FLAGS"))
S SCMAX=$G(SC("MAX"),"*")
M SCFROM=SC("FROM")
S SCPART=$G(SC("PART"))
S SCXREF=$G(SC("XREF"))
S SCREEN=$G(SC("SCREEN"))
S SCID=$G(SC("ID"))
S SCROOT=$G(SC("ROOT"))
; -- for find
S SCVAL=$G(SC("VALUE"))
Q
;
FILEC(SCDATA,SCMODE,SCROOT,SCIENS) ;
N SCRTN,SCFDA,SCERR,N,I
D CHK
D FDASET(.SCROOT,.SCFDA)
; -- set up placeholder DINUM's if any
; -- NOTE: Can't use until multiple arrays can be passed by broker
;S I="" F S I=$O(SCIENS(I)) Q:I="" S SCRTN(+I)=+SCIENS(I)
IF SCMODE="ADD" D
. D UPDATE^DIE("","SCFDA","SCRTN","SCERR")
ELSE D
. D FILE^DIE("","SCFDA","SCERR")
S N=0
;
D SETF("[Data]")
; -- send back info on entry #'s for placeholders
S I=0 F S I=$O(SCRTN(I)) Q:'I D SETF("+"_I_U_SCRTN(I))
;
IF $D(SCERR) D
. D SETF("[Errors]")
. D SETF("An error has occurred.")
Q
;
SETF(X) ;
S N=N+1
S SCDATA(N)=X
Q
;
FDASET(SCROOT,SCFDA) ;
N SCFILE,SCIEN,SCFIELD,SCVAL,SCERR,I
;
S I=0
F S I=$O(SCROOT(I)) Q:'I S X=SCROOT(I) D
. S SCFILE=$P(X,U)
. S SCFIELD=$P(X,U,2)
. S SCIEN=$P(X,U,3)
. S SCVAL=$P(X,U,4)
. D FDA^DILF(SCFILE,SCIEN_",",SCFIELD,"",SCVAL,"SCFDA","SCERR")
Q
;
TMP ; -- temporary envrionment variables sets until kernel tools arrives
IF '$G(DUZ) D
. S DUZ=.5,DUZ(0)="@",U="^",DTIME=300
. D NOW^%DTC S DT=X
Q
;
VALC(SCDATA,SC) ; -- calls Database Validator
N SCFILE,SCIENS,SCFIELD,SCVALUE,SCVAL,SCRSLT,SCERR
D CHK
S SCFLAGS="E"
S SCFILE=$G(SC("FILE"))
S SCIENS=$G(SC("IENS"))
S SCFIELD=$G(SC("FIELD"))
S SCVAL=$G(SC("VALUE"))
;
; -- need to get from kernel broker somehow...
D TMP
;
D VAL^DIE(SCFILE,SCIENS,SCFIELD,SCFLAGS,SCVAL,.SCRSLT,"","SCERR")
;
N Y,N
S N=0
D SET("[FILLER]")
D SET("[Data]")
D SET($G(SCRSLT,U))
D SET($G(SCRSLT(0)))
;
IF $D(SCERR) D
. D SET("[Errors]")
M SCDATA=Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCUTBK 3139 printed Oct 16, 2024@18:44:51 Page 2
SCUTBK ;ALB/MJK - Scheduling Broker Utilities ;[ 03/21/95 4:13 PM ]
+1 ;;5.3;Scheduling;**41,130**;AUG 13, 1993
+2 ;
+3 QUIT
+4 ;
CHK ; -- all broker callbacks pass thru here
+1 QUIT
+2 ;
LISTC(SCDATA,SC) ; -- broker callback to get list data
+1 NEW SCFILE,SCIENS,SCFIELDS,SCMAX,SCFROM,SCPART,SCXREF,SCREEN,SCID,SCVAL,SCROOT,SCERR,SCRSLT,SCFLD
+2 DO CHK
+3 ; -- parse array to parameters
+4 DO PARSE(.SC)
+5 SET SCFLAGS=$GET(SCFLAGS)_"PS"
+6 ;
+7 ; -- get specific field criteria - screen code (below) left as reminder
+8 ;IF $G(SC("DDFILE")),$G(SC("DDFIELD")),$D(^DD(SC("DDFILE"),SC("DDFIELD"),12.1)) D
+9 ;. N DIC X ^(12.1) S:$D(DIC("S")) SCREEN=DIC("S")
+10 ;
+11 ; -- need to get from kernel broker somehow...
+12 DO TMP
+13 ;
+14 DO LIST^DIC(SCFILE,SCIENS,SCFIELDS,SCFLAGS,SCMAX,.SCFROM,SCPART,SCXREF,SCREEN,SCID,"^TMP(""SCRSLT"",$J)","SCERR")
+15 ;
+16 NEW Y,I,N
+17 ;
+18 SET N=0
+19 IF $GET(SCFROM)]""
Begin DoDot:1
+20 DO SET("[Misc]")
+21 DO SET("MORE"_U_SCFROM_U_SCFROM("IEN"))
End DoDot:1
+22 ;
+23 DO SET("[Data]")
+24 SET I=0
FOR
SET I=$ORDER(^TMP("SCRSLT",$JOB,"DILIST",I))
if 'I
QUIT
DO SET(^TMP("SCRSLT",$JOB,"DILIST",I,0))
+25 ;
+26 IF $DATA(SCERR)
Begin DoDot:1
+27 DO SET("[Errors]")
End DoDot:1
+28 ;
+29 MERGE SCDATA=Y
+30 QUIT
+31 ;
SET(X) ;
+1 SET N=N+1
+2 SET Y(N)=X
+3 QUIT
+4 ;
PARSE(SC) ; -- array parsing
+1 SET SCFILE=$GET(SC("FILE"))
+2 SET SCIENS=$GET(SC("IENS"))
+3 SET SCFIELDS=$GET(SC("FIELDS"))
+4 SET SCFLAGS=$GET(SC("FLAGS"))
+5 SET SCMAX=$GET(SC("MAX"),"*")
+6 MERGE SCFROM=SC("FROM")
+7 SET SCPART=$GET(SC("PART"))
+8 SET SCXREF=$GET(SC("XREF"))
+9 SET SCREEN=$GET(SC("SCREEN"))
+10 SET SCID=$GET(SC("ID"))
+11 SET SCROOT=$GET(SC("ROOT"))
+12 ; -- for find
+13 SET SCVAL=$GET(SC("VALUE"))
+14 QUIT
+15 ;
FILEC(SCDATA,SCMODE,SCROOT,SCIENS) ;
+1 NEW SCRTN,SCFDA,SCERR,N,I
+2 DO CHK
+3 DO FDASET(.SCROOT,.SCFDA)
+4 ; -- set up placeholder DINUM's if any
+5 ; -- NOTE: Can't use until multiple arrays can be passed by broker
+6 ;S I="" F S I=$O(SCIENS(I)) Q:I="" S SCRTN(+I)=+SCIENS(I)
+7 IF SCMODE="ADD"
Begin DoDot:1
+8 DO UPDATE^DIE("","SCFDA","SCRTN","SCERR")
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 DO FILE^DIE("","SCFDA","SCERR")
End DoDot:1
+11 SET N=0
+12 ;
+13 DO SETF("[Data]")
+14 ; -- send back info on entry #'s for placeholders
+15 SET I=0
FOR
SET I=$ORDER(SCRTN(I))
if 'I
QUIT
DO SETF("+"_I_U_SCRTN(I))
+16 ;
+17 IF $DATA(SCERR)
Begin DoDot:1
+18 DO SETF("[Errors]")
+19 DO SETF("An error has occurred.")
End DoDot:1
+20 QUIT
+21 ;
SETF(X) ;
+1 SET N=N+1
+2 SET SCDATA(N)=X
+3 QUIT
+4 ;
FDASET(SCROOT,SCFDA) ;
+1 NEW SCFILE,SCIEN,SCFIELD,SCVAL,SCERR,I
+2 ;
+3 SET I=0
+4 FOR
SET I=$ORDER(SCROOT(I))
if 'I
QUIT
SET X=SCROOT(I)
Begin DoDot:1
+5 SET SCFILE=$PIECE(X,U)
+6 SET SCFIELD=$PIECE(X,U,2)
+7 SET SCIEN=$PIECE(X,U,3)
+8 SET SCVAL=$PIECE(X,U,4)
+9 DO FDA^DILF(SCFILE,SCIEN_",",SCFIELD,"",SCVAL,"SCFDA","SCERR")
End DoDot:1
+10 QUIT
+11 ;
TMP ; -- temporary envrionment variables sets until kernel tools arrives
+1 IF '$GET(DUZ)
Begin DoDot:1
+2 SET DUZ=.5
SET DUZ(0)="@"
SET U="^"
SET DTIME=300
+3 DO NOW^%DTC
SET DT=X
End DoDot:1
+4 QUIT
+5 ;
VALC(SCDATA,SC) ; -- calls Database Validator
+1 NEW SCFILE,SCIENS,SCFIELD,SCVALUE,SCVAL,SCRSLT,SCERR
+2 DO CHK
+3 SET SCFLAGS="E"
+4 SET SCFILE=$GET(SC("FILE"))
+5 SET SCIENS=$GET(SC("IENS"))
+6 SET SCFIELD=$GET(SC("FIELD"))
+7 SET SCVAL=$GET(SC("VALUE"))
+8 ;
+9 ; -- need to get from kernel broker somehow...
+10 DO TMP
+11 ;
+12 DO VAL^DIE(SCFILE,SCIENS,SCFIELD,SCFLAGS,SCVAL,.SCRSLT,"","SCERR")
+13 ;
+14 NEW Y,N
+15 SET N=0
+16 DO SET("[FILLER]")
+17 DO SET("[Data]")
+18 DO SET($GET(SCRSLT,U))
+19 DO SET($GET(SCRSLT(0)))
+20 ;
+21 IF $DATA(SCERR)
Begin DoDot:1
+22 DO SET("[Errors]")
End DoDot:1
+23 MERGE SCDATA=Y
+24 QUIT
