165 lines
5.1 KiB
Mathematica
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)
|
||
|
|
;
|