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)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPBK3 5351 printed Apr 09, 2024@22:04:26 Page 2
SCRPBK3 ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96
+1 ;;5.3;Scheduling;**41**;AUG 13, 1993
+2 ;
PRINT(SCDATA,SCPTR,SCDATE,SCTIME,SCQDEF) ;
+1 ; -- print pcmm report
+2 ;
+3 ; input: SCPTR -> printer name
+4 ; SCDATE -> run date
+5 ; SCTIME -> run time
+6 ;
+7 ;output:
+8 ; SCDATA(0) -> TaskMan task number assicated with queued report
+9 ;
+10 ; --- OR if errors were found during validation ---
+11 ;
+12 ; SCDATA(0) -> 0 - meaning errors found ^ <number of errors>
+13 ; SCDATA(1...n) -> error text
+14 ;
+15 ; -- SEE BOTTOM OF SCRPBK FOR MORE VARIABLE DEFINITIONS
+16 ;
+17 ; Related RPC: SCRP REPORT PRINT
+18 ;
+19 NEW SCQREC,SCRUNDT,SCPNTR,SCLOG,DIERR
+20 ;
+21 ; -- build query record
+22 DO PARSE^SCRPBK5(.SCQDEF,.SCQREC)
+23 ;
+24 ; -- do validation full check and report any errors
+25 SET SCLOG="SCDATA"
+26 DO VALCHK^SCRPBK4(SCLOG,.SCQREC,"FULL")
+27 IF $GET(DIERR)
Begin DoDot:1
+28 DO HDREC^SCUTBK3(.SCDATA,DIERR,"Report Printing")
End DoDot:1
GOTO PRINTQ
+29 ;
+30 ; -- process date/time and printer data and retuen in usable format
+31 DO INIT(SCDATE,SCTIME,SCPTR,.SCRUNDT,.SCPNTR)
+32 IF SCQREC("REPORTID")
Begin DoDot:1
+33 ; -- call appropriate report
+34 DO @("RPT"_SCQREC("REPORTID")_"(.SCDATA,.SCQREC,.SCPNTR,.SCRUNDT)")
End DoDot:1
+35 IF '$TEST
Begin DoDot:1
+36 SET SCDATA(0)="0^NOT A VAILD REPORT REQUEST"
End DoDot:1
PRINTQ QUIT
+1 ;
RPT1(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- patient/team assignment
+1 NEW VAUTD,VAUTT,VAUTR,VAUTP
+2 DO BUILD(.SCQREC,"DIVISION",.VAUTD)
+3 DO BUILD(.SCQREC,"TEAM",.VAUTT)
+4 DO BUILD(.SCQREC,"ROLE",.VAUTR)
+5 SET VAUTP=""
DO BUILD(.SCQREC,"PRACTITIONER",.VAUTP)
+6 SET SCDATA(0)=$$ENTRY2^SCRPTA(.VAUTD,.VAUTT,.VAUTR,.VAUTP,SCPNTR,SCRUNDT)
+7 QUIT
+8 ;
RPT2(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- detailed patient enrollments
+1 NEW VAUTD,VAUTT,VAUTC,VAUTA
+2 DO BUILD(.SCQREC,"DIVISION",.VAUTD)
+3 DO BUILD(.SCQREC,"TEAM",.VAUTT)
+4 DO BUILD(.SCQREC,"CLINIC",.VAUTC)
+5 SET VAUTA=$$PASSIGN(.SCQREC,"radAssigned")
+6 SET SCDATA(0)=$$ENTRY2^SCRPEC(.VAUTD,.VAUTT,.VAUTC,VAUTA,SCPNTR,SCRUNDT)
+7 QUIT
+8 ;
RPT3(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- practitioner's demographics
+1 NEW VAUTP
+2 DO BUILD(.SCQREC,"PRACTITIONER",.VAUTP)
+3 SET SCDATA(0)=$$ENTRY2^SCRPRAC(.VAUTP,SCPNTR,SCRUNDT)
+4 QUIT
+5 ;
RPT4(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- practitioner's pateints
+1 NEW VAUTD,VAUTT,VAUTC,VAUTR,VAUTP,VAUTS,SCSORT
+2 DO BUILD(.SCQREC,"DIVISION",.VAUTD)
+3 DO BUILD(.SCQREC,"TEAM",.VAUTT)
+4 DO BUILD(.SCQREC,"ROLE",.VAUTR)
+5 DO BUILD(.SCQREC,"PRACTITIONER",.VAUTP)
+6 SET VAUTS=$$YESNO(.SCQREC,"chkSummary")
+7 SET SCSORT=$$FINDSORT(.SCQREC)
+8 SET SCDATA(0)=$$ENTRY2^SCRPPAT(.VAUTD,.VAUTT,.VAUTR,.VAUTP,VAUTS,SCSORT,SCPNTR,SCRUNDT)
+9 QUIT
+10 ;
RPT5(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- team profile
+1 NEW VAUTD,VAUTT
+2 DO BUILD(.SCQREC,"DIVISION",.VAUTD)
+3 DO BUILD(.SCQREC,"TEAM",.VAUTT)
+4 SET SCDATA(0)=$$ENTRY2^SCRPITP(.VAUTD,.VAUTT,SCPNTR,SCRUNDT)
+5 QUIT
+6 ;
RPT6(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- summaru listing of Teams
+1 NEW VAUTD,VAUTT,VAUTR
+2 DO BUILD(.SCQREC,"DIVISION",.VAUTD)
+3 DO BUILD(.SCQREC,"TEAM",.VAUTT)
+4 DO BUILD(.SCQREC,"ROLE",.VAUTR)
+5 SET SCDATA(0)=$$ENTRY2^SCRPSLT(.VAUTD,.VAUTT,.VAUTR,SCPNTR,SCRUNDT)
+6 QUIT
+7 ;
RPT7(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- team's patients
+1 NEW VAUTD,VAUTT,VAUTR,VAUTPS,SCSORT
+2 DO BUILD(.SCQREC,"DIVISION",.VAUTD)
+3 DO BUILD(.SCQREC,"TEAM",.VAUTT)
+4 DO BUILD(.SCQREC,"ROLE",.VAUTR)
+5 SET VAUTPS=$$PSTATUS(.SCQREC,"radPatStatus")
+6 SET SCSORT=$$FINDSORT(.SCQREC)
+7 SET SCDATA(0)=$$ENTRY2^SCRPTP(.VAUTD,.VAUTT,.VAUTR,.VAUTPS,SCSORT,SCPNTR,SCRUNDT)
+8 QUIT
+9 ;
RPT8(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- team's members
+1 NEW VAUTD,VAUTT,VAUTUC,VAUTR,SCRANG
+2 DO BUILD(.SCQREC,"DIVISION",.VAUTD)
+3 DO BUILD(.SCQREC,"TEAM",.VAUTT)
+4 DO BUILD(.SCQREC,"USERCLASS",.VAUTUC)
+5 DO BUILD(.SCQREC,"ROLE",.VAUTR)
+6 SET SCRANG=$$RANGE(.SCQREC)
+7 SET SCDATA(0)=$$ENTRY2^SCRPTM(.VAUTD,.VAUTT,.VAUTUC,.VAUTR,SCRANG,SCPNTR,SCRUNDT)
+8 QUIT
+9 ;
INIT(SCDATE,SCTIME,SCPTR,SCRUNDT,SCPNTR) ; -- setup of general vars
+1 NEW X
+2 SET SCPNTR="Q;"_SCPTR
+3 SET X=SCDATE_"."_$TRANSLATE($TRANSLATE(SCTIME,":")," ",0)
+4 SET SCRUNDT=+X
+5 QUIT
+6 ;
BUILD(SCQREC,SCTYPE,VAUT) ; -- build selection array
+1 ; is type active
+2 IF '$$CHKTYPE^SCRPBK2(SCTYPE)
GOTO BUILDQ
+3 NEW SCX
+4 SET SCX=""
SET SCRT=$$ROOT(SCTYPE)
+5 FOR
SET SCX=$ORDER(SCQREC("SELECTIONS",SCTYPE,SCX))
if SCX=""
QUIT
Begin DoDot:1
+6 IF $DATA(@SCRT@(+SCX,0))
SET VAUT(+SCX)=$PIECE(^(0),U)
End DoDot:1
+7 IF $ORDER(VAUT(0))
SET VAUT=0
BUILDQ QUIT
+1 ;
ROOT(SCTYPE) ; -- determine global root for file type
+1 NEW Y
+2 IF SCTYPE="DIVISION"
SET Y="^DIC(4)"
GOTO ROOTQ
+3 IF SCTYPE="TEAM"
SET Y="^SCTM(404.51)"
GOTO ROOTQ
+4 IF SCTYPE="PRACTITIONER"
SET Y="^VA(200)"
GOTO ROOTQ
+5 IF SCTYPE="ROLE"
SET Y="^SD(403.46)"
GOTO ROOTQ
+6 IF SCTYPE="CLINIC"
SET Y="^SC"
GOTO ROOTQ
+7 IF SCTYPE="USERCLASS"
SET Y="^USR(8930)"
GOTO ROOTQ
ROOTQ QUIT Y
+1 ;
+2 ;
FINDSORT(SCQREC) ; -- find sort selected in report definition
+1 NEW I,SCRPT,SCSORT,SCSORTID
+2 SET SCSORTID=1
+3 SET SCRPT=+$GET(SCQREC("REPORTID"))
+4 SET SCSORT=$GET(SCQREC("FIELDS","cboSort"))
+5 SET I=0
+6 FOR
SET I=$ORDER(^SD(404.92,SCRPT,"SORTS",I))
if 'I
QUIT
IF $DATA(^(I,0))
IF $PIECE(^(0),U)=SCSORT
SET SCSORTID=I
QUIT
+7 QUIT SCSORTID
+8 ;
YESNO(SCQREC,SCFLD) ; -- determine yes/no field value
+1 QUIT ($GET(SCQREC("FIELDS",SCFLD),"NO")="YES")
+2 ;
PSTATUS(SCQREC,SCFLD) ; -- determine pat status to show
+1 NEW VALUE
+2 SET VALUE=$GET(SCQREC("FIELDS",SCFLD))
+3 SET VALUE=$SELECT(VALUE=""!(VALUE="ALL"):1,1:VALUE)
+4 QUIT VALUE
+5 ;
PASSIGN(SCQREC,SCFLD) ; -- determine if assign patient's is requested
+1 QUIT ($GET(SCQREC("FIELDS",SCFLD))="Primary Care")
+2 ;
RANGE(SCQREC) ; -- deterime date range
+1 QUIT $GET(SCQREC("FIELDS","txtBeginDate"),DT)_U_$GET(SCQREC("FIELDS","txtEndDate"),DT)
+2 ;
