- 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 Apr 23, 2025@18:54:41 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 ;
