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