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