Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCMCDDR2

SCMCDDR2.m

Go to the documentation of this file. 
  1. SCMCDDR2 ;ALB/ART - FileMan FIND1^DIC and GETS^DIQ DBS Call for PCMM Web RPCs ;02/04/2015
  1.  ;;5.3;Scheduling;**603**;Aug 13, 1993;Build 79
  1.  ;
  1.  ;This routine was copied from DDR2.
  1.  ;PCMM Web needs a new RPC that has .11 APP PROXY ALLOWED set to Yes
  1.  ;
  1.  ;DDR2 ;ALB/MJK-FileMan Delphi Components' RPCs ;4/20/98  11:38
  1.  ;;22.0;VA FileMan;;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1.  ;Public, Supported ICRs
  1.  ; #2051 - Database Server API: Lookup Utilities (DIC)
  1.  ; #2053 - Data Base Server API: Editing Utilities (DIE)
  1.  ; #2055 - Data Base Server API: Misc. Data Libaray Functions (DILFD)
  1.  ; #2056 - Data Base Server API: Data Retriever Utilities (DIQ)
  1.  ; #10154 - DESCRIPTOR BLOCK - ^DD
  1.  ;
  1.  QUIT
  1.  ;
  1. FIND1C(SCDATA,SC) ; DDR FIND1 rpc callback
  1.  N SCFILE,SCIENS,SCFLAGS,SCVAL,SCXREF,SCSCRN,SCERR,A,IEN,N,DIERR
  1.  D PARSE(.SC) S SCVAL=$G(SC("VALUE"))
  1.  S A=$$FIND1^DIC(SCFILE,SCIENS,SCFLAGS,SCVAL,SCXREF,SCSCRN,"SCERR")
  1.  S A=$S($G(DIERR):"",1:A)
  1.  S N=0 D SET(A)
  1.  I $G(DIERR) D ERROR Q
  1.  I $G(SCOPT)["R" S IEN=$S($G(SCIENS)]"":A_SCIENS,1:A_",") D RECALL^DILFD(SCFILE,IEN,DUZ)
  1.  Q
  1.  ;
  1. GETSC(SCDATA,SC) ; DDR GETS ENTRY DATA rpc callback
  1.  N SCFILE,SCIENS,SCFLDS,SCFLAGS,SCOPT,SCRSLT,SCERR
  1.  N SCXREF,SCSCRN,N
  1.  D PARSE(.SC)
  1.  D GETS^DIQ(SCFILE,SCIENS,SCFLDS,SCFLAGS,"SCRSLT","SCERR")
  1.  S N=0
  1.  I '$D(SCOPT) D 1,2 Q
  1.  I $G(SCOPT)["U" D 11,21
  1.  I $G(SCOPT)["?" D HLP
  1.  Q
  1.  ;
  1. 1 ;
  1.  I $D(SCRSLT) D
  1.  . N SCFIELD,X,J
  1.  . D SET("[Data]")
  1.  . S SCFIELD=0 F  S SCFIELD=$O(SCRSLT(SCFILE,SCIENS,SCFIELD)) Q:'SCFIELD  D
  1.  . . ;Do not remove stripping of ',' from IENS in line below if this code should work with T11 (21.1T1) of FM components.
  1.  . . S X=SCFILE_"^"_$E(SCIENS,1,$L(SCIENS)-1)_"^"_SCFIELD_"^"
  1.  . . I $P($G(^DD(+$P($G(^DD(SCFILE,SCFIELD,0)),U,2),.01,0)),U,2)["W" D
  1.  . . . D SET(X_"[WORD PROCESSING]")
  1.  . . . S J=0 F  S J=$O(SCRSLT(SCFILE,SCIENS,SCFIELD,J)) Q:'J  D
  1.  . . . . D SET(SCRSLT(SCFILE,SCIENS,SCFIELD,J))
  1.  . . . D SET("$$END$$")
  1.  . . E  D
  1.  . . . D SET(X_$G(SCRSLT(SCFILE,SCIENS,SCFIELD,"I"))_"^"_$G(SCRSLT(SCFILE,SCIENS,SCFIELD,"E")))
  1.  Q
  1.  ;
  1. 11 ;
  1.  N HD,I,E,B,J,K
  1.  D SET("[BEGIN_diDATA]")
  1.  S HD=SCFILE_U_$E(SCIENS,1,$L(SCIENS)-1)
  1.  S I=SCFLAGS["I",E=SCFLAGS["E",B=(I&E)
  1.  S SCFIELD=0 F  S SCFIELD=$O(SCRSLT(SCFILE,SCIENS,SCFIELD)) Q:'SCFIELD  D
  1.  . I $P($G(^DD(+$P($G(^DD(SCFILE,SCFIELD,0)),U,2),.01,0)),U,2)["W" D  Q
  1.  . . S (K,J)=0 F  S K=$O(SCRSLT(SCFILE,SCIENS,SCFIELD,K)) Q:'K  S J=J+1
  1.  . . D SET(HD_U_SCFIELD_U_"W"_U_J)
  1.  . . S J=0  F  S J=$O(SCRSLT(SCFILE,SCIENS,SCFIELD,J)) Q:'J  D SET(SCRSLT(SCFILE,SCIENS,SCFIELD,J))
  1.  . . Q
  1.  . S FLG=$S(B:"B",I:"I",1:"E")
  1.  . D SET(HD_U_SCFIELD_U_FLG)
  1.  . I B D SET(SCRSLT(SCFILE,SCIENS,SCFIELD,"E")),SET(SCRSLT(SCFILE,SCIENS,SCFIELD,"I")) Q
  1.  . I E D SET(SCRSLT(SCFILE,SCIENS,SCFIELD,"E")) Q
  1.  . I I D SET(SCRSLT(SCFILE,SCIENS,SCFIELD,"I")) Q
  1.  D SET("[END_diDATA]")
  1.  Q
  1.  ;
  1. 2 ;
  1.  IF $D(SCERR) D SET("[ERROR]")
  1.  Q
  1.  ;
  1. 21 ;
  1.  I $D(DIERR) D ERROR
  1.  Q
  1.  ;
  1. SET(X) ;
  1.  S N=N+1
  1.  S SCDATA(N)=X
  1.  Q
  1.  ;
  1. HLP ;
  1.  N FLD,FLG,Z,%
  1.  S FLD=0,FLG="?"
  1.  D SET("[BEGIN_diHELP]")
  1.  F Z=1:1 S FLD=+$P(SCFLDS,";",Z) Q:'FLD  D HELP(SCFILE,SCIENS,FLD,FLG)
  1.  D SET("[END_diHELP]")
  1.  Q
  1.  ;
  1. GETHLPC(SCDATA,SC) ; SC GET DD HELP rpc callback
  1.  N SCFILE,SCFIELD,SCFLGS,N
  1.  S SCFILE=$G(SC("FILE"))
  1.  S SCFIELD=$G(SC("FIELD"))
  1.  S SCFLGS=$G(SC("FLAGS"))
  1.  S N=0
  1.  D SET("[BEGIN_diHELP]")
  1.  D HELP(SCFILE,"",SCFIELD,SCFLGS)
  1.  D SET("[END_diHELP]")
  1.  Q
  1.  ;
  1. HELP(FILE,IENS,FIELD,FLGS) ;
  1.  N SCHLP,HD,A
  1.  D HELP^DIE(FILE,IENS,FIELD,FLGS,"SCHLP")
  1.  Q:'$D(SCHLP("DIHELP"))
  1.  S HD=FILE_U_FIELD_U_"?"_U_SCHLP("DIHELP") D SET(HD)
  1.  S A=0 F  S A=$O(SCHLP("DIHELP",A)) Q:'A   D SET(SCHLP("DIHELP",A))
  1.  Q
  1.  ;
  1. ERROR ;
  1.  D SET("[BEGIN_diERRORS]")
  1.  N A S A=0 F  S A=$O(SCERR("DIERR",A)) Q:'A  D
  1.  . N HD,PARAM,B,C,TEXT,TXTCNT,D,FILE,FIELD,IENS,%
  1.  . S HD=SCERR("DIERR",A)
  1.  . I $D(SCERR("DIERR",A,"PARAM",0)) D
  1.  . . S (B,D)=0 F C=1:1 S B=$O(SCERR("DIERR",A,"PARAM",B)) Q:B=""  D
  1.  . . . I B="FILE" S FILE=SCERR("DIERR",A,"PARAM","FILE")
  1.  . . . I B="FIELD" S FIELD=SCERR("DIERR",A,"PARAM","FIELD")
  1.  . . . I B="IENS" S IENS=SCERR("DIERR",A,"PARAM","IENS")
  1.  . . . S D=D+1,PARAM(D)=B_U_SCERR("DIERR",A,"PARAM",B)
  1.  . S C=0 F  S C=$O(SCERR("DIERR",A,"TEXT",C)) Q:'C  S TEXT(C)=SCERR("DIERR",A,"TEXT",C),TXTCNT=C
  1.  . S HD=HD_U_TXTCNT_U_$G(FILE)_U_$G(IENS)_U_$G(FIELD)_U_$G(D) D SET(HD)
  1.  . S B=0 F  S B=$O(PARAM(B)) Q:'B  S %=PARAM(B) D SET(%)
  1.  . S B=0 F  S B=$O(TEXT(B)) Q:'B  S %=TEXT(B) D SET(%)
  1.  . Q
  1.  D SET("[END_diERRORS]")
  1.  Q
  1.  ;
  1. PARSE(SC) ;
  1.  S SCFILE=$G(SC("FILE"))
  1.  S SCIENS=$G(SC("IENS"))
  1.  S SCFLDS=$G(SC("FIELDS"))
  1.  S SCFLAGS=$G(SC("FLAGS"))
  1.  S SCXREF=$G(SC("XREF"))
  1.  S SCSCRN=$G(SC("SCREEN"))
  1.  S:$D(SC("OPTIONS")) SCOPT=SC("OPTIONS")
  1.  Q
  1.  ;