source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPBK3.m@ 711

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)
 ;