SCMCDDR3 ;ALB/ART - FileMan FILE^DIC and UPDATE^DIC DBS Calls for PCMM Web RPCs ;02/04/2015
;;5.3;Scheduling;**603**;Aug 13, 1993;Build 79
;
;This routine was copied from DDR3.
;PCMM Web needs a new RPC that has .11 APP PROXY ALLOWED set to Yes
;
;DDR3 ;ALB/MJK,SF/DCM-FileMan Delphi Components' RPCs ;2/24/98 10:01
;;22.0;VA FileMan;;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
;
;Public, Supported ICRs
; #2053 - Data Base Server API: Editing Utilities (DIE)
; #2054 - Data Base Server API: Misc. Library Functions (DILF)
;
QUIT
;
FILEC(SCDATA,SCMODE,SCROOT,SCFLAGS,SCIENS) ; DDR FILER rpc callback
N SCRTN,SCFDA,SCERR,N,I
D FDASET(.SCROOT,.SCFDA)
; -- set up placeholder DINUM's if any
; -- NOTE: Can't use until multiple arrays can be passed by broker
I $D(SCROOT("IENs")) M SCIENS=SCROOT("IENs")
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
. S SCFLAGS=$S($D(SCFLAGS):SCFLAGS,1:"")
. D FILE^DIE(SCFLAGS,"SCFDA","SCERR")
S N=0
D SET("[Data]")
; -- send back info on entry #'s for placeholders
S I=0 F S I=$O(SCRTN(I)) Q:'I D SET("+"_I_","_U_SCRTN(I))
IF $D(SCERR) D ERROR
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,99)
. D FDA^DILF(SCFILE,SCIEN_$S($E(SCIEN,$L(SCIEN))'=",":",",1:""),SCFIELD,"",SCVAL,"SCFDA","SCERR")
Q
;
SET(X) ;
S N=N+1
S SCDATA(N)=X
Q
ERROR ;
D SET("[BEGIN_diERRORS]")
N A S A=0 F S A=$O(SCERR("DIERR",A)) Q:'A D
. N HD,PARAM,B,C,TEXT,TXTCNT,D,FILE,FIELD,IENS,%
. S HD=SCERR("DIERR",A)
. I $D(SCERR("DIERR",A,"PARAM",0)) D
. . S (B,D)=0 F C=1:1 S B=$O(SCERR("DIERR",A,"PARAM",B)) Q:B="" D
. . . I B="FILE" S FILE=SCERR("DIERR",A,"PARAM","FILE")
. . . I B="FIELD" S FIELD=SCERR("DIERR",A,"PARAM","FIELD")
. . . I B="IENS" S IENS=SCERR("DIERR",A,"PARAM","IENS")
. . . S D=D+1,PARAM(D)=B_U_SCERR("DIERR",A,"PARAM",B)
. S C=0 F S C=$O(SCERR("DIERR",A,"TEXT",C)) Q:'C S TEXT(C)=SCERR("DIERR",A,"TEXT",C),TXTCNT=C
. S HD=HD_U_TXTCNT_U_$G(FILE)_U_$G(IENS)_U_$G(FIELD)_U_$G(D) D SET(HD)
. S B=0 F S B=$O(PARAM(B)) Q:'B S %=PARAM(B) D SET(%)
. S B=0 F S B=$O(TEXT(B)) Q:'B S %=TEXT(B) D SET(%)
. Q
D SET("[END_diERRORS]")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCDDR3 2456 printed Nov 22, 2024@17:50:09 Page 2
SCMCDDR3 ;ALB/ART - FileMan FILE^DIC and UPDATE^DIC DBS Calls for PCMM Web RPCs ;02/04/2015
+1 ;;5.3;Scheduling;**603**;Aug 13, 1993;Build 79
+2 ;
+3 ;This routine was copied from DDR3.
+4 ;PCMM Web needs a new RPC that has .11 APP PROXY ALLOWED set to Yes
+5 ;
+6 ;DDR3 ;ALB/MJK,SF/DCM-FileMan Delphi Components' RPCs ;2/24/98 10:01
+7 ;;22.0;VA FileMan;;Mar 30, 1999
+8 ;Per VHA Directive 10-93-142, this routine should not be modified.
+9 ;
+10 ;Public, Supported ICRs
+11 ; #2053 - Data Base Server API: Editing Utilities (DIE)
+12 ; #2054 - Data Base Server API: Misc. Library Functions (DILF)
+13 ;
+14 QUIT
+15 ;
FILEC(SCDATA,SCMODE,SCROOT,SCFLAGS,SCIENS) ; DDR FILER rpc callback
+1 NEW SCRTN,SCFDA,SCERR,N,I
+2 DO FDASET(.SCROOT,.SCFDA)
+3 ; -- set up placeholder DINUM's if any
+4 ; -- NOTE: Can't use until multiple arrays can be passed by broker
+5 IF $DATA(SCROOT("IENs"))
MERGE SCIENS=SCROOT("IENs")
+6 SET I=""
FOR
SET I=$ORDER(SCIENS(I))
if I=""
QUIT
SET 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 SET SCFLAGS=$SELECT($DATA(SCFLAGS):SCFLAGS,1:"")
+11 DO FILE^DIE(SCFLAGS,"SCFDA","SCERR")
End DoDot:1
+12 SET N=0
+13 DO SET("[Data]")
+14 ; -- send back info on entry #'s for placeholders
+15 SET I=0
FOR
SET I=$ORDER(SCRTN(I))
if 'I
QUIT
DO SET("+"_I_","_U_SCRTN(I))
+16 IF $DATA(SCERR)
DO ERROR
+17 QUIT
+18 ;
FDASET(SCROOT,SCFDA) ;
+1 NEW SCFILE,SCIEN,SCFIELD,SCVAL,SCERR,I
+2 SET I=0
+3 FOR
SET I=$ORDER(SCROOT(I))
if 'I
QUIT
SET X=SCROOT(I)
Begin DoDot:1
+4 SET SCFILE=$PIECE(X,U)
+5 SET SCFIELD=$PIECE(X,U,2)
+6 SET SCIEN=$PIECE(X,U,3)
+7 SET SCVAL=$PIECE(X,U,4,99)
+8 DO FDA^DILF(SCFILE,SCIEN_$SELECT($EXTRACT(SCIEN,$LENGTH(SCIEN))'=",":",",1:""),SCFIELD,"",SCVAL,"SCFDA","SCERR")
End DoDot:1
+9 QUIT
+10 ;
SET(X) ;
+1 SET N=N+1
+2 SET SCDATA(N)=X
+3 QUIT
ERROR ;
+1 DO SET("[BEGIN_diERRORS]")
+2 NEW A
SET A=0
FOR
SET A=$ORDER(SCERR("DIERR",A))
if 'A
QUIT
Begin DoDot:1
+3 NEW HD,PARAM,B,C,TEXT,TXTCNT,D,FILE,FIELD,IENS,%
+4 SET HD=SCERR("DIERR",A)
+5 IF $DATA(SCERR("DIERR",A,"PARAM",0))
Begin DoDot:2
+6 SET (B,D)=0
FOR C=1:1
SET B=$ORDER(SCERR("DIERR",A,"PARAM",B))
if B=""
QUIT
Begin DoDot:3
+7 IF B="FILE"
SET FILE=SCERR("DIERR",A,"PARAM","FILE")
+8 IF B="FIELD"
SET FIELD=SCERR("DIERR",A,"PARAM","FIELD")
+9 IF B="IENS"
SET IENS=SCERR("DIERR",A,"PARAM","IENS")
+10 SET D=D+1
SET PARAM(D)=B_U_SCERR("DIERR",A,"PARAM",B)
End DoDot:3
End DoDot:2
+11 SET C=0
FOR
SET C=$ORDER(SCERR("DIERR",A,"TEXT",C))
if 'C
QUIT
SET TEXT(C)=SCERR("DIERR",A,"TEXT",C)
SET TXTCNT=C
+12 SET HD=HD_U_TXTCNT_U_$GET(FILE)_U_$GET(IENS)_U_$GET(FIELD)_U_$GET(D)
DO SET(HD)
+13 SET B=0
FOR
SET B=$ORDER(PARAM(B))
if 'B
QUIT
SET %=PARAM(B)
DO SET(%)
+14 SET B=0
FOR
SET B=$ORDER(TEXT(B))
if 'B
QUIT
SET %=TEXT(B)
DO SET(%)
+15 QUIT
End DoDot:1
+16 DO SET("[END_diERRORS]")
+17 QUIT
+18 ;
