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

SCRPBK2.m

Go to the documentation of this file. 
  1. SCRPBK2 ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96
  1.  ;;5.3;Scheduling;**41**;AUG 13, 1993
  1.  ;
  1. SAVE(SCDATA,SCQDEF) ; -- save query definition
  1.  ;
  1.  ; -- SCDATA(0) -> <1 - success> ^ <new query ien> ^ <reload client>
  1.  ;              -> <0 - errors found> ^ <number of errors>
  1.  ;      (1...n) -> error text
  1.  ;
  1.  ; -- SEE BOTTOM OF SCRPBK FOR VARIABLE DEFINITIONS
  1.  ;
  1.  ; Related RPC: SCRP QUERY SAVE
  1.  ;
  1.  N SCQREC,SCERR,SCIENS,SCSTAT,SCVM,SCLOG,SCERS,DIERR,SCPROC
  1.  S SCPROC="Save Template"
  1.  D PARSE^SCRPBK5(.SCQDEF,.SCQREC)
  1.  ;
  1.  ; -- do full validation mode(SCVM) check
  1.  S SCVM="FULL",SCLOG="SCDATA"
  1.  D VALCHK^SCRPBK4(SCLOG,.SCQREC,SCVM)
  1.  IF $G(DIERR) D  G SAVEQ
  1.  . D HDREC^SCUTBK3(.SCDATA,DIERR,"Save Template Validation Check")
  1.  ;
  1.  ; -- try to save record and get status of save
  1.  S SCSTAT=$$SAVEREC(.SCQREC,.SCIENS,.SCERR)
  1.  IF SCSTAT D
  1.  . S SCDATA(0)=1_U_$S(SCQREC("QUERYID")="+1":+$G(SCIENS(1)),1:"")_U_$P(SCSTAT,U,2)
  1.  ELSE  D
  1.  . D ERRCHK^SCUTBK3(.SCDATA,.SCERR,SCPROC)
  1. SAVEQ Q
  1.  ;
  1. SAVEREC(SCQREC,SCIENS,SCERR) ; -- actual save process
  1.  N SCFILE,SCFDA,SCDFDA,SCQRY,SCNEW,SCMOD
  1.  S SCFILE=404.95
  1.  S SCFDA="SCFDA",SCDFDA="SCDFDA",SCERR="SCERR",SCIENS="SCIENS"
  1.  S SCQRY=SCQREC("QUERYID")
  1.  ;
  1.  ; -- strip out data not needed
  1.  ;    SCMOD = 1 means some stripping occurred and query needs to reload
  1.  S SCMOD=$$STRIP(.SCQREC)
  1.  ;
  1.  D FDA^DILF(SCFILE,SCQRY_",",.01,"",SCQREC("NAME"),SCFDA,SCERR)
  1.  D FDA^DILF(SCFILE,SCQRY_",",.02,"",SCQREC("CREATORID"),SCFDA,SCERR)
  1.  D FDA^DILF(SCFILE,SCQRY_",",.03,"",SCQREC("ACCESSID"),SCFDA,SCERR)
  1.  D FDA^DILF(SCFILE,SCQRY_",",.04,"",SCQREC("REPORTID"),SCFDA,SCERR)
  1.  D FDA^DILF(SCFILE,SCQRY_",",.05,"",$$NOW^XLFDT(),SCFDA,SCERR)
  1.  IF $D(SCQREC("DESCRIPTION")) D
  1.  . D FDA^DILF(SCFILE,SCQRY_",",10,"",$NA(SCQREC("DESCRIPTION")),SCFDA,SCERR)
  1.  ; -- is this a new record?
  1.  S SCNEW=$S(SCQRY="+1":1,1:0)
  1.  D SAVFLD(.SCQREC,.SCFDA,.SCDFDA,.SCERR,.SCNEW)
  1.  D SAVSEL(.SCQREC,.SCFDA,.SCDFDA,.SCERR,.SCNEW)
  1.  ;
  1.  ; -- process any deletions (SCDFDA array holds deletion FDA)
  1.  IF $D(SCDFDA)>10 D
  1.  . D FILE^DIE("K",SCDFDA,SCERR)
  1.  ;
  1.  ; -- process new items and changes
  1.  IF SCNEW D
  1.  . D UPDATE^DIE("",SCFDA,SCIENS,SCERR)
  1.  ELSE  D
  1.  . D FILE^DIE("K",SCFDA,SCERR)
  1.  ;
  1.  ; -- ret := <success 0/1> ^ <unneeded data automatically stripped out>
  1. SAVERECQ Q '$G(SCERR("DIERR"))_U_SCMOD
  1.  ;
  1. SAVFLD(SCQREC,SCFDA,SCDFDA,SCERR,SCNEW) ;
  1.  ; -- determine which fields were changed or deleted
  1.  ;
  1.  N SCUR,SCAN,SCQRY,SCI,SCFLD
  1.  S SCQRY=SCQREC("QUERYID")
  1.  ;
  1.  ; -- scan fields multiple and build array
  1.  S SCI=0
  1.  F  S SCI=$O(^SD(404.95,SCQRY,"FIELDS",SCI)) Q:'SCI  S X=$G(^(SCI,0)) D
  1.  . IF $D(^SD(404.93,+X,0)) S SCAN($P(^(0),U,2))=SCI_U_$P(X,U,2)
  1.  ;
  1.  ; -- delete fields not passed down and set delete fda
  1.  S SCFLD=""
  1.  F  S SCFLD=$O(SCAN(SCFLD)) Q:SCFLD=""  IF '$D(SCQREC("FIELDS",SCFLD)) D
  1.  . D FDA^DILF(404.9502,+SCAN(SCFLD)_","_SCQRY_",",.01,"","@",SCDFDA,SCERR)
  1.  ;
  1.  ; -- set fda for changes
  1.  S SCFLD=""
  1.  F  S SCFLD=$O(SCQREC("FIELDS",SCFLD)) Q:SCFLD=""  D
  1.  . N SCVAL,SCFLDI,SCIEN,SCUR
  1.  . S SCVAL=SCQREC("FIELDS",SCFLD)
  1.  . S SCFLDI=+$O(^SD(404.93,"C",SCFLD,0))
  1.  . S SCUR=$G(SCAN(SCFLD))
  1.  . S SCIEN=+SCUR IF 'SCIEN S SCNEW=SCNEW+1,SCIEN="+"_SCNEW
  1.  . IF SCIEN="+1"!($P(SCUR,U,2)'=SCVAL) D
  1.  . . D FDA^DILF(404.9502,SCIEN_","_SCQRY_",",.01,"",SCFLDI,SCFDA,SCERR)
  1.  . . D FDA^DILF(404.9502,SCIEN_","_SCQRY_",",.02,"",SCVAL,SCFDA,SCERR)
  1.  Q
  1.  ;
  1. SAVSEL(SCQREC,SCFDA,SCDFDA,SCERR,SCNEW) ;
  1.  ;  -- determine which file selections were changed or deleted
  1.  ;
  1.  N SCUR,SCAN,SCQRY,SCI,SCSEL,SCTYPE,SCHIT
  1.  S SCQRY=SCQREC("QUERYID")
  1.  ; -- scan fields and build array
  1.  S SCI=0
  1.  F  S SCI=$O(^SD(404.95,SCQRY,"FILES",SCI)) Q:'SCI  S X=$G(^(SCI,0)) D
  1.  . S SCAN($P(^(0),U))=SCI
  1.  ;
  1.  ; -- delete fields not passed down
  1.  S SCSEL=""
  1.  F  S SCSEL=$O(SCAN(SCSEL)) Q:SCSEL=""  D
  1.  . S SCTYPE="",SCHIT=0
  1.  . F  S SCTYPE=$O(SCQREC("SELECTIONS",SCTYPE)) Q:SCTYPE=""  IF $D(SCQREC("SELECTIONS",SCTYPE,SCSEL)) S SCHIT=1 Q
  1.  . D:'SCHIT FDA^DILF(404.9503,+SCAN(SCSEL)_","_SCQRY_",",.01,"","@",SCDFDA,SCERR)
  1.  ;
  1.  ; -- set fda
  1.  S SCTYPE=""
  1.  F  S SCTYPE=$O(SCQREC("SELECTIONS",SCTYPE)) Q:SCTYPE=""  D
  1.  . S SCSEL=""
  1.  . F  S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL=""  IF '$D(SCAN(SCSEL)) D
  1.  . . S SCNEW=SCNEW+1,SCIEN="+"_SCNEW
  1.  . . D FDA^DILF(404.9503,SCIEN_","_SCQRY_",",.01,"",SCSEL,SCFDA,SCERR)
  1.  Q
  1.  ;
  1. DELETE(SCDATA,SCQDEF) ; -- delete a query record
  1.  ;
  1.  ; -- SCDATA(0) -> <1 - success> ^
  1.  ;              -> <0 - errors found> ^ <number of errors>
  1.  ;      (1...n) -> error text
  1.  ;
  1.  ; -- SEE BOTTOM OF SCRPBK FOR VARIABLE DEFINITIONS
  1.  ;
  1.  ; Related RPC: SCRP QUERY DELETE
  1.  ;
  1.  N SCQREC,DIERR,SCLOG
  1.  S SCLOG="SCDATA"
  1.  D PARSE^SCRPBK5(.SCQDEF,.SCQREC)
  1.  D DELCHK(SCLOG,.SCQREC)
  1.  D HDREC^SCUTBK3(.SCDATA,$G(DIERR),"Template Deletion")
  1.  IF SCDATA(0) D DELREC(.SCQREC)
  1.  Q
  1.  ;
  1. DELCHK(SCLOG,SCQREC) ; -- check to see if query can be deleted
  1.  ; -- is the query being used as a default by any user?
  1.  ;
  1.  N SCQRY,PARAM
  1.  S SCQRY=SCQREC("QUERYID")
  1.  IF SCQRY=+SCQRY,'$D(^SCRS(403.35,"AC",SCQRY)) D  G DELCHKQ
  1.  . Q
  1.  ELSE  D
  1.  . S SCPARM("QUERY NAME")=SCQREC("NAME")
  1.  . D BLD^DIALOG(4035002.001,.SCPARM,"",SCLOG,"S")
  1. DELCHKQ Q
  1.  ;
  1. DELREC(SCQREC) ; -- actually delete query record
  1.  N DIK,DA,X
  1.  S DIK="^SD(404.95,",DA=SCQREC("QUERYID") D ^DIK
  1.  Q
  1.  ;
  1. NAME(SCDATA,SCQNAME,SCUSER) ;
  1.  ; -- check to see if user has a query with same name
  1.  ; 
  1.  ; input: SCQNAME -> query name
  1.  ;        SCUSER  -> user id (DUZ)
  1.  ;output: SCDATA(1) -> 0 means no query with that name found
  1.  ;                  -> <n> means query with that name found has this ien
  1.  ; -- SEE BOTTOM OF SCRPBK FOR VARIABLE DEFINITIONS
  1.  ;
  1.  ; Related RPC: SCRP QUERY CHECK NAME
  1.  ;
  1.  N SCERR,SCDUP
  1.  IF $$NAMECHK(.SCQNAME,.SCUSER,.SCERR,.SCDUP) D
  1.  . S SCDATA(1)=0
  1.  ELSE  D
  1.  . S SCDATA(1)=SCDUP
  1.  Q
  1.  ;
  1. NAMECHK(SCQNAME,SCUSER,SCERR,SCDUP) ; -- actuallt scan xref for query name
  1.  N SCOK,SDI
  1.  S SCOK=1,SCI=0
  1.  F  S SCI=$O(^SD(404.95,"AC",SCUSER,SCI)) Q:'SCI  D  Q:'SCOK
  1.  . IF SCQNAME=$P($G(^SD(404.95,SCI,0)),U) S SCOK=0,SCDUP=SCI
  1.  Q SCOK
  1.  ;
  1. STRIP(SCQREC) ; -- strip out inappropriate data for report type
  1.  N I,X,SCAN,SCFLD,SCMOD
  1.  S SCMOD=0
  1.  D GETFLDS(+SCQREC("REPORTID"),.SCAN)
  1.  S SCFLD=""
  1.  F  S SCFLD=$O(SCQREC("FIELDS",SCFLD)) Q:SCFLD=""  D
  1.  . IF '$D(SCAN(SCFLD)) K SCQREC("FIELDS",SCFLD) S SCMOD=1
  1.  ;
  1.  K SCAN
  1.  D GETYPE(+SCQREC("REPORTID"),.SCAN)
  1.  S SCTYPE=""
  1.  F  S SCTYPE=$O(SCQREC("SELECTIONS",SCTYPE)) Q:SCTYPE=""  D
  1.  . IF '$D(SCAN(SCTYPE)) K SCQREC("SELECTIONS",SCTYPE) S SCMOD=1
  1.  Q SCMOD
  1.  ;
  1. GETFLDS(RPTID,SCAN) ; -- build array of fields used/needed by report
  1.  N SCI,SCX
  1.  S SCI=0
  1.  F  S SCI=$O(^SD(404.92,RPTID,"FIELDS",SCI)) Q:'SCI  S SCX=$G(^(SCI,0)) D
  1.  . IF $D(^SD(404.93,+SCX,0)) S SCAN($P(^(0),U,2))=SCX
  1.  Q
  1.  ;
  1. GETYPE(RPTID,SCAN) ; -- build array of files used/needed by report
  1.  N SCI,SCX
  1.  S SCI=0
  1.  F  S SCI=$O(^SD(404.92,RPTID,"FILES",SCI)) Q:'SCI  S SCX=$G(^(SCI,0)) D
  1.  . S SCTYPE=$$TYPE^SCRPBK(+SCX)
  1.  . IF $$CHKTYPE(SCTYPE) S SCAN(SCTYPE)=SCX
  1.  Q
  1.  ;
  1. CHKTYPE(SCTYPE) ; -- special checks to see if file type is ok to use
  1.  N SCOK S SCOK=1
  1.  IF SCTYPE="" S SCOK=0
  1.  ;
  1.  ; -- is site using user class relationship in PCMM?
  1.  IF SCTYPE="USERCLASS",'$P($G(^SD(404.91,1,"PCMM")),U) S SCOK=0
  1.  Q SCOK
  1.  ;