VistA-WorldVistAEHR/r/SCHEDULING-SD-SC/SCRPBK3.m

165 lines
5.1 KiB
Mathematica

SCRPBK3 ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96
;;5.3;Scheduling;**41**;AUG 13, 1993
;
PRINT(SCDATA,SCPTR,SCDATE,SCTIME,SCQDEF) ;
; -- print pcmm report
;
; input: SCPTR -> printer name
; SCDATE -> run date
; SCTIME -> run time
;
;output:
; SCDATA(0) -> TaskMan task number assicated with queued report
;
; --- OR if errors were found during validation ---
;
; SCDATA(0) -> 0 - meaning errors found ^ <number of errors>
; SCDATA(1...n) -> error text
;
; -- SEE BOTTOM OF SCRPBK FOR MORE VARIABLE DEFINITIONS
;
; Related RPC: SCRP REPORT PRINT
;
N SCQREC,SCRUNDT,SCPNTR,SCLOG,DIERR
;
; -- build query record
D PARSE^SCRPBK5(.SCQDEF,.SCQREC)
;
; -- do validation full check and report any errors
S SCLOG="SCDATA"
D VALCHK^SCRPBK4(SCLOG,.SCQREC,"FULL")
IF $G(DIERR) D G PRINTQ
. D HDREC^SCUTBK3(.SCDATA,DIERR,"Report Printing")
;
; -- process date/time and printer data and retuen in usable format
D INIT(SCDATE,SCTIME,SCPTR,.SCRUNDT,.SCPNTR)
IF SCQREC("REPORTID") D
. ; -- call appropriate report
. D @("RPT"_SCQREC("REPORTID")_"(.SCDATA,.SCQREC,.SCPNTR,.SCRUNDT)")
ELSE D
. S SCDATA(0)="0^NOT A VAILD REPORT REQUEST"
PRINTQ Q
;
RPT1(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- patient/team assignment
N VAUTD,VAUTT,VAUTR,VAUTP
D BUILD(.SCQREC,"DIVISION",.VAUTD)
D BUILD(.SCQREC,"TEAM",.VAUTT)
D BUILD(.SCQREC,"ROLE",.VAUTR)
S VAUTP="" D BUILD(.SCQREC,"PRACTITIONER",.VAUTP)
S SCDATA(0)=$$ENTRY2^SCRPTA(.VAUTD,.VAUTT,.VAUTR,.VAUTP,SCPNTR,SCRUNDT)
Q
;
RPT2(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- detailed patient enrollments
N VAUTD,VAUTT,VAUTC,VAUTA
D BUILD(.SCQREC,"DIVISION",.VAUTD)
D BUILD(.SCQREC,"TEAM",.VAUTT)
D BUILD(.SCQREC,"CLINIC",.VAUTC)
S VAUTA=$$PASSIGN(.SCQREC,"radAssigned")
S SCDATA(0)=$$ENTRY2^SCRPEC(.VAUTD,.VAUTT,.VAUTC,VAUTA,SCPNTR,SCRUNDT)
Q
;
RPT3(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- practitioner's demographics
N VAUTP
D BUILD(.SCQREC,"PRACTITIONER",.VAUTP)
S SCDATA(0)=$$ENTRY2^SCRPRAC(.VAUTP,SCPNTR,SCRUNDT)
Q
;
RPT4(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- practitioner's pateints
N VAUTD,VAUTT,VAUTC,VAUTR,VAUTP,VAUTS,SCSORT
D BUILD(.SCQREC,"DIVISION",.VAUTD)
D BUILD(.SCQREC,"TEAM",.VAUTT)
D BUILD(.SCQREC,"ROLE",.VAUTR)
D BUILD(.SCQREC,"PRACTITIONER",.VAUTP)
S VAUTS=$$YESNO(.SCQREC,"chkSummary")
S SCSORT=$$FINDSORT(.SCQREC)
S SCDATA(0)=$$ENTRY2^SCRPPAT(.VAUTD,.VAUTT,.VAUTR,.VAUTP,VAUTS,SCSORT,SCPNTR,SCRUNDT)
Q
;
RPT5(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- team profile
N VAUTD,VAUTT
D BUILD(.SCQREC,"DIVISION",.VAUTD)
D BUILD(.SCQREC,"TEAM",.VAUTT)
S SCDATA(0)=$$ENTRY2^SCRPITP(.VAUTD,.VAUTT,SCPNTR,SCRUNDT)
Q
;
RPT6(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- summaru listing of Teams
N VAUTD,VAUTT,VAUTR
D BUILD(.SCQREC,"DIVISION",.VAUTD)
D BUILD(.SCQREC,"TEAM",.VAUTT)
D BUILD(.SCQREC,"ROLE",.VAUTR)
S SCDATA(0)=$$ENTRY2^SCRPSLT(.VAUTD,.VAUTT,.VAUTR,SCPNTR,SCRUNDT)
Q
;
RPT7(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- team's patients
N VAUTD,VAUTT,VAUTR,VAUTPS,SCSORT
D BUILD(.SCQREC,"DIVISION",.VAUTD)
D BUILD(.SCQREC,"TEAM",.VAUTT)
D BUILD(.SCQREC,"ROLE",.VAUTR)
S VAUTPS=$$PSTATUS(.SCQREC,"radPatStatus")
S SCSORT=$$FINDSORT(.SCQREC)
S SCDATA(0)=$$ENTRY2^SCRPTP(.VAUTD,.VAUTT,.VAUTR,.VAUTPS,SCSORT,SCPNTR,SCRUNDT)
Q
;
RPT8(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- team's members
N VAUTD,VAUTT,VAUTUC,VAUTR,SCRANG
D BUILD(.SCQREC,"DIVISION",.VAUTD)
D BUILD(.SCQREC,"TEAM",.VAUTT)
D BUILD(.SCQREC,"USERCLASS",.VAUTUC)
D BUILD(.SCQREC,"ROLE",.VAUTR)
S SCRANG=$$RANGE(.SCQREC)
S SCDATA(0)=$$ENTRY2^SCRPTM(.VAUTD,.VAUTT,.VAUTUC,.VAUTR,SCRANG,SCPNTR,SCRUNDT)
Q
;
INIT(SCDATE,SCTIME,SCPTR,SCRUNDT,SCPNTR) ; -- setup of general vars
N X
S SCPNTR="Q;"_SCPTR
S X=SCDATE_"."_$TR($TR(SCTIME,":")," ",0)
S SCRUNDT=+X
Q
;
BUILD(SCQREC,SCTYPE,VAUT) ; -- build selection array
; is type active
IF '$$CHKTYPE^SCRPBK2(SCTYPE) G BUILDQ
N SCX
S SCX="",SCRT=$$ROOT(SCTYPE)
F S SCX=$O(SCQREC("SELECTIONS",SCTYPE,SCX)) Q:SCX="" D
. IF $D(@SCRT@(+SCX,0)) S VAUT(+SCX)=$P(^(0),U)
IF $O(VAUT(0)) S VAUT=0
BUILDQ Q
;
ROOT(SCTYPE) ; -- determine global root for file type
N Y
IF SCTYPE="DIVISION" S Y="^DIC(4)" G ROOTQ
IF SCTYPE="TEAM" S Y="^SCTM(404.51)" G ROOTQ
IF SCTYPE="PRACTITIONER" S Y="^VA(200)" G ROOTQ
IF SCTYPE="ROLE" S Y="^SD(403.46)" G ROOTQ
IF SCTYPE="CLINIC" S Y="^SC" G ROOTQ
IF SCTYPE="USERCLASS" S Y="^USR(8930)" G ROOTQ
ROOTQ Q Y
;
;
FINDSORT(SCQREC) ; -- find sort selected in report definition
N I,SCRPT,SCSORT,SCSORTID
S SCSORTID=1
S SCRPT=+$G(SCQREC("REPORTID"))
S SCSORT=$G(SCQREC("FIELDS","cboSort"))
S I=0
F S I=$O(^SD(404.92,SCRPT,"SORTS",I)) Q:'I IF $D(^(I,0)),$P(^(0),U)=SCSORT S SCSORTID=I Q
Q SCSORTID
;
YESNO(SCQREC,SCFLD) ; -- determine yes/no field value
Q ($G(SCQREC("FIELDS",SCFLD),"NO")="YES")
;
PSTATUS(SCQREC,SCFLD) ; -- determine pat status to show
N VALUE
S VALUE=$G(SCQREC("FIELDS",SCFLD))
S VALUE=$S(VALUE=""!(VALUE="ALL"):1,1:VALUE)
Q VALUE
;
PASSIGN(SCQREC,SCFLD) ; -- determine if assign patient's is requested
Q ($G(SCQREC("FIELDS",SCFLD))="Primary Care")
;
RANGE(SCQREC) ; -- deterime date range
Q $G(SCQREC("FIELDS","txtBeginDate"),DT)_U_$G(SCQREC("FIELDS","txtEndDate"),DT)
;