| [613] | 1 | SCUTBK ;ALB/MJK - Scheduling Broker Utilities ;[ 03/21/95  4:13 PM ]
 | 
|---|
 | 2 |  ;;5.3;Scheduling;**41,130**;AUG 13, 1993
 | 
|---|
 | 3 |  ;
 | 
|---|
 | 4 |  Q
 | 
|---|
 | 5 |  ;
 | 
|---|
 | 6 | CHK ; -- all broker callbacks pass thru here
 | 
|---|
 | 7 |  Q
 | 
|---|
 | 8 |  ;
 | 
|---|
 | 9 | LISTC(SCDATA,SC) ; -- broker callback to get list data
 | 
|---|
 | 10 |  N SCFILE,SCIENS,SCFIELDS,SCMAX,SCFROM,SCPART,SCXREF,SCREEN,SCID,SCVAL,SCROOT,SCERR,SCRSLT,SCFLD
 | 
|---|
 | 11 |  D CHK
 | 
|---|
 | 12 |  ; -- parse array to parameters
 | 
|---|
 | 13 |  D PARSE(.SC)
 | 
|---|
 | 14 |  S SCFLAGS=$G(SCFLAGS)_"PS"
 | 
|---|
 | 15 |  ;
 | 
|---|
 | 16 |  ; -- get specific field criteria  - screen code (below) left as reminder
 | 
|---|
 | 17 |  ;IF $G(SC("DDFILE")),$G(SC("DDFIELD")),$D(^DD(SC("DDFILE"),SC("DDFIELD"),12.1)) D
 | 
|---|
 | 18 |  ;. N DIC X ^(12.1) S:$D(DIC("S")) SCREEN=DIC("S")
 | 
|---|
 | 19 |  ;
 | 
|---|
 | 20 |  ; -- need to get from kernel broker somehow...
 | 
|---|
 | 21 |  D TMP
 | 
|---|
 | 22 |  ;
 | 
|---|
 | 23 |  D LIST^DIC(SCFILE,SCIENS,SCFIELDS,SCFLAGS,SCMAX,.SCFROM,SCPART,SCXREF,SCREEN,SCID,"^TMP(""SCRSLT"",$J)","SCERR")
 | 
|---|
 | 24 |  ;
 | 
|---|
 | 25 |  N Y,I,N
 | 
|---|
 | 26 |  ;
 | 
|---|
 | 27 |  S N=0
 | 
|---|
 | 28 |  IF $G(SCFROM)]"" D
 | 
|---|
 | 29 |  . D SET("[Misc]")
 | 
|---|
 | 30 |  . D SET("MORE"_U_SCFROM_U_SCFROM("IEN"))
 | 
|---|
 | 31 |  ;
 | 
|---|
 | 32 |  D SET("[Data]")
 | 
|---|
 | 33 |  S I=0 F  S I=$O(^TMP("SCRSLT",$J,"DILIST",I)) Q:'I  D SET(^TMP("SCRSLT",$J,"DILIST",I,0))
 | 
|---|
 | 34 |  ;
 | 
|---|
 | 35 |  IF $D(SCERR) D
 | 
|---|
 | 36 |  . D SET("[Errors]")
 | 
|---|
 | 37 |  ;
 | 
|---|
 | 38 |  M SCDATA=Y
 | 
|---|
 | 39 |  Q
 | 
|---|
 | 40 |  ;
 | 
|---|
 | 41 | SET(X) ;
 | 
|---|
 | 42 |  S N=N+1
 | 
|---|
 | 43 |  S Y(N)=X
 | 
|---|
 | 44 |  Q
 | 
|---|
 | 45 |  ;
 | 
|---|
 | 46 | PARSE(SC) ; -- array parsing
 | 
|---|
 | 47 |  S SCFILE=$G(SC("FILE"))
 | 
|---|
 | 48 |  S SCIENS=$G(SC("IENS"))
 | 
|---|
 | 49 |  S SCFIELDS=$G(SC("FIELDS"))
 | 
|---|
 | 50 |  S SCFLAGS=$G(SC("FLAGS"))
 | 
|---|
 | 51 |  S SCMAX=$G(SC("MAX"),"*")
 | 
|---|
 | 52 |  M SCFROM=SC("FROM")
 | 
|---|
 | 53 |  S SCPART=$G(SC("PART"))
 | 
|---|
 | 54 |  S SCXREF=$G(SC("XREF"))
 | 
|---|
 | 55 |  S SCREEN=$G(SC("SCREEN"))
 | 
|---|
 | 56 |  S SCID=$G(SC("ID"))
 | 
|---|
 | 57 |  S SCROOT=$G(SC("ROOT"))
 | 
|---|
 | 58 |  ; -- for find
 | 
|---|
 | 59 |  S SCVAL=$G(SC("VALUE"))
 | 
|---|
 | 60 |  Q
 | 
|---|
 | 61 |  ;
 | 
|---|
 | 62 | FILEC(SCDATA,SCMODE,SCROOT,SCIENS) ;
 | 
|---|
 | 63 |  N SCRTN,SCFDA,SCERR,N,I
 | 
|---|
 | 64 |  D CHK
 | 
|---|
 | 65 |  D FDASET(.SCROOT,.SCFDA)
 | 
|---|
 | 66 |  ; -- set up placeholder DINUM's if any
 | 
|---|
 | 67 |  ; -- NOTE:  Can't use until multiple arrays can be passed by broker
 | 
|---|
 | 68 |  ;S I="" F  S I=$O(SCIENS(I)) Q:I=""  S SCRTN(+I)=+SCIENS(I)
 | 
|---|
 | 69 |  IF SCMODE="ADD" D
 | 
|---|
 | 70 |  . D UPDATE^DIE("","SCFDA","SCRTN","SCERR")
 | 
|---|
 | 71 |  ELSE  D
 | 
|---|
 | 72 |  . D FILE^DIE("","SCFDA","SCERR")
 | 
|---|
 | 73 |  S N=0
 | 
|---|
 | 74 |  ;
 | 
|---|
 | 75 |  D SETF("[Data]")
 | 
|---|
 | 76 |  ; -- send back info on entry #'s for placeholders
 | 
|---|
 | 77 |  S I=0 F  S I=$O(SCRTN(I)) Q:'I  D SETF("+"_I_U_SCRTN(I))
 | 
|---|
 | 78 |  ;
 | 
|---|
 | 79 |  IF $D(SCERR) D
 | 
|---|
 | 80 |  . D SETF("[Errors]")
 | 
|---|
 | 81 |  . D SETF("An error has occurred.")
 | 
|---|
 | 82 |  Q
 | 
|---|
 | 83 |  ;
 | 
|---|
 | 84 | SETF(X) ;
 | 
|---|
 | 85 |  S N=N+1
 | 
|---|
 | 86 |  S SCDATA(N)=X
 | 
|---|
 | 87 |  Q
 | 
|---|
 | 88 |  ;
 | 
|---|
 | 89 | FDASET(SCROOT,SCFDA) ;
 | 
|---|
 | 90 |  N SCFILE,SCIEN,SCFIELD,SCVAL,SCERR,I
 | 
|---|
 | 91 |  ;
 | 
|---|
 | 92 |  S I=0
 | 
|---|
 | 93 |  F  S I=$O(SCROOT(I)) Q:'I  S X=SCROOT(I) D
 | 
|---|
 | 94 |  . S SCFILE=$P(X,U)
 | 
|---|
 | 95 |  . S SCFIELD=$P(X,U,2)
 | 
|---|
 | 96 |  . S SCIEN=$P(X,U,3)
 | 
|---|
 | 97 |  . S SCVAL=$P(X,U,4)
 | 
|---|
 | 98 |  . D FDA^DILF(SCFILE,SCIEN_",",SCFIELD,"",SCVAL,"SCFDA","SCERR")
 | 
|---|
 | 99 |  Q
 | 
|---|
 | 100 |  ;
 | 
|---|
 | 101 | TMP ; -- temporary envrionment variables sets until kernel tools arrives
 | 
|---|
 | 102 |  IF '$G(DUZ) D
 | 
|---|
 | 103 |  . S DUZ=.5,DUZ(0)="@",U="^",DTIME=300
 | 
|---|
 | 104 |  . D NOW^%DTC S DT=X
 | 
|---|
 | 105 |  Q
 | 
|---|
 | 106 |  ;
 | 
|---|
 | 107 | VALC(SCDATA,SC) ; -- calls Database Validator
 | 
|---|
 | 108 |  N SCFILE,SCIENS,SCFIELD,SCVALUE,SCVAL,SCRSLT,SCERR
 | 
|---|
 | 109 |  D CHK
 | 
|---|
 | 110 |  S SCFLAGS="E"
 | 
|---|
 | 111 |  S SCFILE=$G(SC("FILE"))
 | 
|---|
 | 112 |  S SCIENS=$G(SC("IENS"))
 | 
|---|
 | 113 |  S SCFIELD=$G(SC("FIELD"))
 | 
|---|
 | 114 |  S SCVAL=$G(SC("VALUE"))
 | 
|---|
 | 115 |  ;
 | 
|---|
 | 116 |  ; -- need to get from kernel broker somehow...
 | 
|---|
 | 117 |  D TMP
 | 
|---|
 | 118 |  ;
 | 
|---|
 | 119 |  D VAL^DIE(SCFILE,SCIENS,SCFIELD,SCFLAGS,SCVAL,.SCRSLT,"","SCERR")
 | 
|---|
 | 120 |  ;
 | 
|---|
 | 121 |  N Y,N
 | 
|---|
 | 122 |  S N=0
 | 
|---|
 | 123 |  D SET("[FILLER]")
 | 
|---|
 | 124 |  D SET("[Data]")
 | 
|---|
 | 125 |  D SET($G(SCRSLT,U))
 | 
|---|
 | 126 |  D SET($G(SCRSLT(0)))
 | 
|---|
 | 127 |  ;
 | 
|---|
 | 128 |  IF $D(SCERR) D
 | 
|---|
 | 129 |  . D SET("[Errors]")
 | 
|---|
 | 130 |  M SCDATA=Y
 | 
|---|
 | 131 |  Q
 | 
|---|