SCUTBK.m

SCUTBK ;ALB/MJK - Scheduling Broker Utilities ;[ 03/21/95  4:13 PM ]

 ;;5.3;Scheduling;**41,130,1015**;AUG 13, 1993;Build 21

 ;

 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

SCUTBK    ;ALB/MJK - Scheduling Broker Utilities ;[ 03/21/95  4:13 PM ]

 +1       ;;5.3;Scheduling;**41,130,1015**;AUG 13, 1993;Build 21

 +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