Routine: SCRPBK3

SCRPBK3 ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96

 ;;5.3;Scheduling;**41,1015**;AUG 13, 1993;Build 21

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)

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)

RPT3(SCDATA,SCQREC,SCPNTR,SCRUNDT) ; -- practitioner's demographics

 N VAUTP

 D BUILD(.SCQREC,"PRACTITIONER",.VAUTP)

 S SCDATA(0)=$$ENTRY2^SCRPRAC(.VAUTP,SCPNTR,SCRUNDT)

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)

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)

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)

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)

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)

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

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)

SCRPBK3   ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96

 +1       ;;5.3;Scheduling;**41,1015**;AUG 13, 1993;Build 21

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

SCRPBK3.m