SCRPO3 ;BP-CIOFO/KEITH - Historical Provider Position Assignment Listing ; 9/14/99 10:06am
;;5.3;Scheduling;**177,598**;AUG 13, 1993;Build 12
;
EN ;Queue report
N LIST,SORT,RTN,DESC,SCSP
S LIST="DIV,TEAM,POS,ASPR,CLINIC",SORT="DV,TM,TP,PR,EC",SCSP="PR"
S RTN="RUN^SCRPO3"
S DESC="Historical Provider Position Assignment Listing"
D PROMPT^SCRPO1(LIST,SORT,SCSP,RTN,DESC) Q
;
RUN ;Print report
N SCFMT,SCTITL,SCTITL2,SCLINE,SCPAGE,SCOUT,SCFF,SCX,SCPNOW,SCFD
N SC1,SC2,SC3,SC4,SC5,SC6,SCN,SCI,SCPNOW,SCY,SCFF,SCLINE,SCPAGE
S SCFMT=$E(^TMP("SC",$J,"FMT")),(SCFF,SCOUT)=0
D BUILD(SCFMT) Q:SCOUT S SCI=0
D HINI D:$E(IOST)="C" DISP0^SCRPW23
;print report parameters
S SCTITL(2)=$$HDRX("P") D HDR^SCRPO(.SCTITL,132) Q:SCOUT S SCOUT=$$PPAR^SCRPO(.SC,,.SCTITL)=0
Q:SCOUT
;print negative report
I '$D(^TMP("SCRPT",$J,0)) D G EXIT
.K SCTITL(2) D HDR^SCRPO(.SCTITL,132) Q:SCOUT
.S SCX="No provider position assignments found within selected report parameters!"
.W !!?(132-$L(SCX)\2),SCX
.Q
S SCPAGE=1
;print detailed report
I SCFMT="D" S SCTITL(2)=$$HDRX("D") D HDR^SCRPO(.SCTITL,132),SHDR("D") Q:SCOUT D
.S SC1=""
.F S SC1=$O(^TMP("SCRPT",$J,1,SC1)) Q:SC1=""!SCOUT D
..S SC2=""
..F S SC2=$O(^TMP("SCRPT",$J,1,SC1,SC2)) Q:SC2=""!SCOUT D
...S SC3=""
...F S SC3=$O(^TMP("SCRPT",$J,1,SC1,SC2,SC3)) Q:SC3=""!SCOUT D
....S SCN=^TMP("SCRPT",$J,1,SC1,SC2,SC3),SC4=""
....F S SC4=$O(^TMP("SCRPT",$J,2,SCN,SC4)) Q:SC4=""!SCOUT D
.....S SC5=""
.....F S SC5=$O(^TMP("SCRPT",$J,2,SCN,SC4,SC5)) Q:SC5=""!SCOUT D
......S SC6=""
......F S SC6=$O(^TMP("SCRPT",$J,2,SCN,SC4,SC5,SC6)) Q:SC6=""!SCOUT D
.......S SCX=^TMP("SCRPT",$J,2,SCN,SC4,SC5,SC6)
.......I $Y>(IOSL-11) D FOOT1,HDR^SCRPO(.SCTITL,132),SHDR("D") Q:SCOUT
.......S SCY="0^21^41^46^67^86^94^102^110^118^126" W !
.......F SCI=1:1:5 W ?($P(SCY,U,SCI)),$P(SCX,U,SCI)
.......F SCI=6:1:11 W ?($P(SCY,U,SCI)),$J($P(SCX,U,SCI),6,0)
......Q
.....Q
....Q
...Q
..Q
.D:'SCOUT FOOT1
.Q
G:SCOUT EXIT
;print summary report
S SCTITL(2)=$$HDRX("S") D HDR^SCRPO(.SCTITL,132),SHDR("S") G:SCOUT EXIT
S (SCFD,SCDIV)=0
F S SCDIV=$O(^TMP("SCRPT",$J,0,SCDIV)) Q:SCDIV=""!SCOUT D
.S SCPC=$S($D(^TMP("SCRPT",$J,0,SCDIV,"PC")):"YES",1:"NO")
.S SCX=^TMP("SCRPT",$J,0,SCDIV)
.D:$Y>(IOSL-11) FOOT2,HDR^SCRPO(.SCTITL,132),SHDR("S") Q:SCOUT
.W:SCFD ! D SLINE(SCDIV,SCPC,SCX) S SCTEAM="",SCFD=1
.F S SCTEAM=$O(^TMP("SCRPT",$J,0,SCDIV,1,SCTEAM)) Q:SCTEAM=""!SCOUT D
..S SCPC=$S($D(^TMP("SCRPT",$J,0,SCDIV,1,SCTEAM,"PC")):"YES",1:"NO")
..S SCX=^TMP("SCRPT",$J,0,SCDIV,1,SCTEAM)
..D:$Y>(IOSL-10) FOOT2,HDR^SCRPO(.SCTITL,132),SHDR("S") Q:SCOUT
..D SLINE(" "_SCTEAM,SCPC,SCX)
..Q
.Q
G:SCOUT EXIT
;bp/djb Stop displaying PC? on Total line
;Old code begin
;S SCPC=$S($D(^TMP("SCRPT",$J,0,0,"PC")):"YES",1:"NO")
;Old code end
;New code begin
S SCPC=""
;New code end
S SCX=^TMP("SCRPT",$J,0,0)
W ! D SLINE("REPORT TOTAL:",SCPC,SCX)
D FOOT2
;
EXIT I $E(IOST)="C",'$G(SCOUT) W ! N DIR S DIR(0)="E" D ^DIR
F SCI="SC","SCARR","SCRPT" K ^TMP(SCI,$J)
K SC D END^SCRPW50 Q
;
SLINE(SCNAME,SCPC,SCX) ;Print report summary line
;Input: SCNAME=division or team name to print
;Input: SCPC=primary care y/n
;Input: SCX=slot/assignment data
;
W !?22,$P(SCNAME,U),?56,SCPC
F SCI=1:1:6 W ?(53+(8*SCI)),$J($P(SCX,U,SCI),6,0)
Q
;
HINI ;Initialize header variables
N Y
S SCTITL(1)="<*> HISTORICAL PROVIDER POSITION ASSIGNMENT LISTING <*>"
S SCLINE="",$P(SCLINE,"-",133)="",SCPAGE=1
S Y=$$NOW^XLFDT() X ^DD("DD") S SCPNOW=$P(Y,":",1,2)
Q
;
SHDR(SCX) ;Print report subheader
;Input: SCX='D' for detail, 'S' for summary
Q:SCOUT
I SCX="S" D Q
.W !?63,"Max.",?69,"---Assigned---",?93,"---Precepted--"
.W !?22,"Division",?63,"Pts.",?69,"---Patients---",?87,"Open"
.W ?93,"---Patients---",!?24,"Team",?56,"PC? Allow. PC"
.W ?77,"Non-PC Slots PC Non-PC"
.W !?22,"-------------------------------- --- ------ ------ ------ ------ ------ ------"
.Q
W !?88,"Max. ---Assigned---",?118,"---Precepted--",!
W ?88,"Pts. ---Patients--- Open ---Patients---",!,"Provider Name"
W ?21,"Position",?41,"PC? Team",?67,"Associated Clinic"
W ?86,"Allow. PC Non-PC Slots PC Non-PC"
W !,"------------------- ------------------ --- ------------------- ----------------- ------ ------ ------ ------ ------ ------"
Q
;
HDRX(SCX) ;extra header line
;Input: SCX='P' for parameters, 'D' for detail, 'S' for summary
Q:SCX="P" "Selected Report Parameters"
Q $S(SCX="D":"Detail",1:"Summary")_" for Provider Position Assignments Effective: "_^TMP("SC",$J,"DTR","PBDT")_" to "_^TMP("SC",$J,"DTR","PEDT")
;
STOP ;Check for stop task request
S:$D(ZTQUEUED) (SCOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
;
BUILD(SCFMT) ;Build report data
;Input: SCFMT=report format (detail or summary)
N SCTM,SCTP,SCPR,SCARR,ERR,SCI
;Build from provider list
I $O(^TMP("SC",$J,"ASPR",0)) S SCPR=0 D Q
.;Corrected variable name SCTP to SCPR SD*5.3*598
.F S SCPR=$O(^TMP("SC",$J,"ASPR",SCPR)) Q:'SCPR!SCOUT D
..D STOP Q:SCOUT
..M SCDT=^TMP("SC",$J,"DTR") S SCDT="SCDT"
..S SCARR="^TMP(""SCARR"",$J,1)" K @SCARR
..S SCI=$$TPPR^SCAPMC(SCPR,.SCDT,,,SCARR,"ERR")
..S SCTM=0 F S SCTM=$O(^TMP("SCARR",$J,1,"SCTP",SCTM)) Q:'SCTM D
...S SCTP=0 F S SCTP=$O(^TMP("SCARR",$J,1,"SCTP",SCTM,SCTP)) Q:'SCTP D
....S ^TMP("SCARR",$J,0,SCTP)=""
....Q
...Q
..Q
.S SCTP=0 F S SCTP=$O(^TMP("SCARR",$J,0,SCTP)) Q:'SCTP!SCOUT D
..D CKPOS(SCTP,SCFMT),STOP
..Q
.Q
;Build from position list
I $O(^TMP("SC",$J,"POS",0)) S SCTP=0 D Q
.F S SCTP=$O(^TMP("SC",$J,"POS",SCTP)) Q:'SCTP!SCOUT D
..D CKPOS(SCTP,SCFMT),STOP
..Q
.Q
;Build from all positions
S SCTP=0 F S SCTP=$O(^SCTM(404.57,SCTP)) Q:'SCTP!SCOUT D
.D CKPOS(SCTP,SCFMT),STOP
.Q
Q
;
CKPOS(SCTP,SCFMT) ;Check team position
;Input: SCTP=TEAM POSITION ifn
;Input: SCFMT=report format (detail or summary)
;
N SCDIV,SCTEAM,SCPOS,SCLINIC,SCTP0,SCX
S SCTP0=$G(^SCTM(404.57,+SCTP,0)) Q:'$L(SCTP0)
S SCX=$P(SCTP0,U) Q:'$L(SCX)
S SCPOS=SCX_U_SCTP
S SCTEAM=$P(SCTP0,U,2) Q:'$$TMDV^SCRPO1(.SCTEAM,.SCDIV)
S SCLINIC=$P(SCTP0,U,9) Q:'$$TPCL^SCRPO1(.SCLINIC)
D BTPOS(SCTP,SCDIV,SCTEAM,SCPOS,SCLINIC,SCFMT)
Q
;
BTPOS(SCTP,SCDIV,SCTEAM,SCPOS,SCLINIC,SCFMT) ;Build from team position
;Input: SCTP=team position ifn
;Input: SCDIV=division^ifn
;Input: SCTEAM=team^ifn
;Input: SCPOS=team position^ifn
;Input: SCLINIC=associated clinic^ifn (if one exists)
;Input: SCFMT=report format (detail or summary)
;
N SCARR,SCDT,SCI,SCPASS,ERR
S SCARR="^TMP(""SCARR"",$J,1)" K @SCARR
M SCDT=^TMP("SC",$J,"DTR") S SCDT="SCDT"
S SCI=$$PRTP^SCAPMC(SCTP,.SCDT,SCARR,"ERR",0,0),SCI=0
F S SCI=$O(^TMP("SCARR",$J,1,SCI)) Q:'SCI D
.S SCPASS=^TMP("SCARR",$J,1,SCI)
.D BPRPA^SCRPO4(SCPASS,SCDIV,SCTEAM,SCPOS,SCLINIC,SCFMT)
.Q
Q
;
N SCI
F SCI=1:1:80 W ! Q:$Y>(IOSL-9)
W !,SCLINE
W !,"NOTE: This report reflects a count of all unique patients assigned to Primary Care and non-Primary Care within the date range"
W !?6,"selected. If a date range larger than one day has been selected, the total patients assigned to a provider may be greater"
W !?6,"than the maximum defined for the position. However, this does not imply that the provider had more than their maximum"
W !?6,"number of patients on any single date."
W !,SCLINE
Q
;
N SCI
F SCI=1:1:80 W ! Q:$Y>(IOSL-8)
W !,SCLINE
W !,"NOTE: Although presented by division and team, the maximum patients allowed, assigned patients, open slots and precepted patients"
W !?6,"reflected in this summary represent a sum of those categories for the provider position assignments identified within the"
W !?6,"user specified parameters of this report and may not match the maximum patients, etc. defined for the team as a whole."
W !,SCLINE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPO3 8025 printed Dec 13, 2024@02:42:42 Page 2
SCRPO3 ;BP-CIOFO/KEITH - Historical Provider Position Assignment Listing ; 9/14/99 10:06am
+1 ;;5.3;Scheduling;**177,598**;AUG 13, 1993;Build 12
+2 ;
EN ;Queue report
+1 NEW LIST,SORT,RTN,DESC,SCSP
+2 SET LIST="DIV,TEAM,POS,ASPR,CLINIC"
SET SORT="DV,TM,TP,PR,EC"
SET SCSP="PR"
+3 SET RTN="RUN^SCRPO3"
+4 SET DESC="Historical Provider Position Assignment Listing"
+5 DO PROMPT^SCRPO1(LIST,SORT,SCSP,RTN,DESC)
QUIT
+6 ;
RUN ;Print report
+1 NEW SCFMT,SCTITL,SCTITL2,SCLINE,SCPAGE,SCOUT,SCFF,SCX,SCPNOW,SCFD
+2 NEW SC1,SC2,SC3,SC4,SC5,SC6,SCN,SCI,SCPNOW,SCY,SCFF,SCLINE,SCPAGE
+3 SET SCFMT=$EXTRACT(^TMP("SC",$JOB,"FMT"))
SET (SCFF,SCOUT)=0
+4 DO BUILD(SCFMT)
if SCOUT
QUIT
SET SCI=0
+5 DO HINI
if $EXTRACT(IOST)="C"
DO DISP0^SCRPW23
+6 ;print report parameters
+7 SET SCTITL(2)=$$HDRX("P")
DO HDR^SCRPO(.SCTITL,132)
if SCOUT
QUIT
SET SCOUT=$$PPAR^SCRPO(.SC,,.SCTITL)=0
+8 if SCOUT
QUIT
+9 ;print negative report
+10 IF '$DATA(^TMP("SCRPT",$JOB,0))
Begin DoDot:1
+11 KILL SCTITL(2)
DO HDR^SCRPO(.SCTITL,132)
if SCOUT
QUIT
+12 SET SCX="No provider position assignments found within selected report parameters!"
+13 WRITE !!?(132-$LENGTH(SCX)\2),SCX
+14 QUIT
End DoDot:1
GOTO EXIT
+15 SET SCPAGE=1
+16 ;print detailed report
+17 IF SCFMT="D"
SET SCTITL(2)=$$HDRX("D")
DO HDR^SCRPO(.SCTITL,132)
DO SHDR("D")
if SCOUT
QUIT
Begin DoDot:1
+18 SET SC1=""
+19 FOR
SET SC1=$ORDER(^TMP("SCRPT",$JOB,1,SC1))
if SC1=""!SCOUT
QUIT
Begin DoDot:2
+20 SET SC2=""
+21 FOR
SET SC2=$ORDER(^TMP("SCRPT",$JOB,1,SC1,SC2))
if SC2=""!SCOUT
QUIT
Begin DoDot:3
+22 SET SC3=""
+23 FOR
SET SC3=$ORDER(^TMP("SCRPT",$JOB,1,SC1,SC2,SC3))
if SC3=""!SCOUT
QUIT
Begin DoDot:4
+24 SET SCN=^TMP("SCRPT",$JOB,1,SC1,SC2,SC3)
SET SC4=""
+25 FOR
SET SC4=$ORDER(^TMP("SCRPT",$JOB,2,SCN,SC4))
if SC4=""!SCOUT
QUIT
Begin DoDot:5
+26 SET SC5=""
+27 FOR
SET SC5=$ORDER(^TMP("SCRPT",$JOB,2,SCN,SC4,SC5))
if SC5=""!SCOUT
QUIT
Begin DoDot:6
+28 SET SC6=""
+29 FOR
SET SC6=$ORDER(^TMP("SCRPT",$JOB,2,SCN,SC4,SC5,SC6))
if SC6=""!SCOUT
QUIT
Begin DoDot:7
+30 SET SCX=^TMP("SCRPT",$JOB,2,SCN,SC4,SC5,SC6)
+31 IF $Y>(IOSL-11)
DO FOOT1
DO HDR^SCRPO(.SCTITL,132)
DO SHDR("D")
if SCOUT
QUIT
+32 SET SCY="0^21^41^46^67^86^94^102^110^118^126"
WRITE !
+33 FOR SCI=1:1:5
WRITE ?($PIECE(SCY,U,SCI)),$PIECE(SCX,U,SCI)
+34 FOR SCI=6:1:11
WRITE ?($PIECE(SCY,U,SCI)),$JUSTIFY($PIECE(SCX,U,SCI),6,0)
End DoDot:7
+35 QUIT
End DoDot:6
+36 QUIT
End DoDot:5
+37 QUIT
End DoDot:4
+38 QUIT
End DoDot:3
+39 QUIT
End DoDot:2
+40 if 'SCOUT
DO FOOT1
+41 QUIT
End DoDot:1
+42 if SCOUT
GOTO EXIT
+43 ;print summary report
+44 SET SCTITL(2)=$$HDRX("S")
DO HDR^SCRPO(.SCTITL,132)
DO SHDR("S")
if SCOUT
GOTO EXIT
+45 SET (SCFD,SCDIV)=0
+46 FOR
SET SCDIV=$ORDER(^TMP("SCRPT",$JOB,0,SCDIV))
if SCDIV=""!SCOUT
QUIT
Begin DoDot:1
+47 SET SCPC=$SELECT($DATA(^TMP("SCRPT",$JOB,0,SCDIV,"PC")):"YES",1:"NO")
+48 SET SCX=^TMP("SCRPT",$JOB,0,SCDIV)
+49 if $Y>(IOSL-11)
DO FOOT2
DO HDR^SCRPO(.SCTITL,132)
DO SHDR("S")
if SCOUT
QUIT
+50 if SCFD
WRITE !
DO SLINE(SCDIV,SCPC,SCX)
SET SCTEAM=""
SET SCFD=1
+51 FOR
SET SCTEAM=$ORDER(^TMP("SCRPT",$JOB,0,SCDIV,1,SCTEAM))
if SCTEAM=""!SCOUT
QUIT
Begin DoDot:2
+52 SET SCPC=$SELECT($DATA(^TMP("SCRPT",$JOB,0,SCDIV,1,SCTEAM,"PC")):"YES",1:"NO")
+53 SET SCX=^TMP("SCRPT",$JOB,0,SCDIV,1,SCTEAM)
+54 if $Y>(IOSL-10)
DO FOOT2
DO HDR^SCRPO(.SCTITL,132)
DO SHDR("S")
if SCOUT
QUIT
+55 DO SLINE(" "_SCTEAM,SCPC,SCX)
+56 QUIT
End DoDot:2
+57 QUIT
End DoDot:1
+58 if SCOUT
GOTO EXIT
+59 ;bp/djb Stop displaying PC? on Total line
+60 ;Old code begin
+61 ;S SCPC=$S($D(^TMP("SCRPT",$J,0,0,"PC")):"YES",1:"NO")
+62 ;Old code end
+63 ;New code begin
+64 SET SCPC=""
+65 ;New code end
+66 SET SCX=^TMP("SCRPT",$JOB,0,0)
+67 WRITE !
DO SLINE("REPORT TOTAL:",SCPC,SCX)
+68 DO FOOT2
+69 ;
EXIT IF $EXTRACT(IOST)="C"
IF '$GET(SCOUT)
WRITE !
NEW DIR
SET DIR(0)="E"
DO ^DIR
+1 FOR SCI="SC","SCARR","SCRPT"
KILL ^TMP(SCI,$JOB)
+2 KILL SC
DO END^SCRPW50
QUIT
+3 ;
SLINE(SCNAME,SCPC,SCX) ;Print report summary line
+1 ;Input: SCNAME=division or team name to print
+2 ;Input: SCPC=primary care y/n
+3 ;Input: SCX=slot/assignment data
+4 ;
+5 WRITE !?22,$PIECE(SCNAME,U),?56,SCPC
+6 FOR SCI=1:1:6
WRITE ?(53+(8*SCI)),$JUSTIFY($PIECE(SCX,U,SCI),6,0)
+7 QUIT
+8 ;
HINI ;Initialize header variables
+1 NEW Y
+2 SET SCTITL(1)="<*> HISTORICAL PROVIDER POSITION ASSIGNMENT LISTING <*>"
+3 SET SCLINE=""
SET $PIECE(SCLINE,"-",133)=""
SET SCPAGE=1
+4 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET SCPNOW=$PIECE(Y,":",1,2)
+5 QUIT
+6 ;
SHDR(SCX) ;Print report subheader
+1 ;Input: SCX='D' for detail, 'S' for summary
+2 if SCOUT
QUIT
+3 IF SCX="S"
Begin DoDot:1
+4 WRITE !?63,"Max.",?69,"---Assigned---",?93,"---Precepted--"
+5 WRITE !?22,"Division",?63,"Pts.",?69,"---Patients---",?87,"Open"
+6 WRITE ?93,"---Patients---",!?24,"Team",?56,"PC? Allow. PC"
+7 WRITE ?77,"Non-PC Slots PC Non-PC"
+8 WRITE !?22,"-------------------------------- --- ------ ------ ------ ------ ------ ------"
+9 QUIT
End DoDot:1
QUIT
+10 WRITE !?88,"Max. ---Assigned---",?118,"---Precepted--",!
+11 WRITE ?88,"Pts. ---Patients--- Open ---Patients---",!,"Provider Name"
+12 WRITE ?21,"Position",?41,"PC? Team",?67,"Associated Clinic"
+13 WRITE ?86,"Allow. PC Non-PC Slots PC Non-PC"
+14 WRITE !,"------------------- ------------------ --- ------------------- ----------------- ------ ------ ------ ------ ------ ------"
+15 QUIT
+16 ;
HDRX(SCX) ;extra header line
+1 ;Input: SCX='P' for parameters, 'D' for detail, 'S' for summary
+2 if SCX="P"
QUIT "Selected Report Parameters"
+3 QUIT $SELECT(SCX="D":"Detail",1:"Summary")_" for Provider Position Assignments Effective: "_^TMP("SC",$JOB,"DTR","PBDT")_" to "_^TMP("SC",$JOB,"DTR","PEDT")
+4 ;
STOP ;Check for stop task request
+1 if $DATA(ZTQUEUED)
SET (SCOUT,ZTSTOP)=$SELECT($$S^%ZTLOAD:1,1:0)
QUIT
+2 ;
BUILD(SCFMT) ;Build report data
+1 ;Input: SCFMT=report format (detail or summary)
+2 NEW SCTM,SCTP,SCPR,SCARR,ERR,SCI
+3 ;Build from provider list
+4 IF $ORDER(^TMP("SC",$JOB,"ASPR",0))
SET SCPR=0
Begin DoDot:1
+5 ;Corrected variable name SCTP to SCPR SD*5.3*598
+6 FOR
SET SCPR=$ORDER(^TMP("SC",$JOB,"ASPR",SCPR))
if 'SCPR!SCOUT
QUIT
Begin DoDot:2
+7 DO STOP
if SCOUT
QUIT
+8 MERGE SCDT=^TMP("SC",$JOB,"DTR")
SET SCDT="SCDT"
+9 SET SCARR="^TMP(""SCARR"",$J,1)"
KILL @SCARR
+10 SET SCI=$$TPPR^SCAPMC(SCPR,.SCDT,,,SCARR,"ERR")
+11 SET SCTM=0
FOR
SET SCTM=$ORDER(^TMP("SCARR",$JOB,1,"SCTP",SCTM))
if 'SCTM
QUIT
Begin DoDot:3
+12 SET SCTP=0
FOR
SET SCTP=$ORDER(^TMP("SCARR",$JOB,1,"SCTP",SCTM,SCTP))
if 'SCTP
QUIT
Begin DoDot:4
+13 SET ^TMP("SCARR",$JOB,0,SCTP)=""
+14 QUIT
End DoDot:4
+15 QUIT
End DoDot:3
+16 QUIT
End DoDot:2
+17 SET SCTP=0
FOR
SET SCTP=$ORDER(^TMP("SCARR",$JOB,0,SCTP))
if 'SCTP!SCOUT
QUIT
Begin DoDot:2
+18 DO CKPOS(SCTP,SCFMT)
DO STOP
+19 QUIT
End DoDot:2
+20 QUIT
End DoDot:1
QUIT
+21 ;Build from position list
+22 IF $ORDER(^TMP("SC",$JOB,"POS",0))
SET SCTP=0
Begin DoDot:1
+23 FOR
SET SCTP=$ORDER(^TMP("SC",$JOB,"POS",SCTP))
if 'SCTP!SCOUT
QUIT
Begin DoDot:2
+24 DO CKPOS(SCTP,SCFMT)
DO STOP
+25 QUIT
End DoDot:2
+26 QUIT
End DoDot:1
QUIT
+27 ;Build from all positions
+28 SET SCTP=0
FOR
SET SCTP=$ORDER(^SCTM(404.57,SCTP))
if 'SCTP!SCOUT
QUIT
Begin DoDot:1
+29 DO CKPOS(SCTP,SCFMT)
DO STOP
+30 QUIT
End DoDot:1
+31 QUIT
+32 ;
CKPOS(SCTP,SCFMT) ;Check team position
+1 ;Input: SCTP=TEAM POSITION ifn
+2 ;Input: SCFMT=report format (detail or summary)
+3 ;
+4 NEW SCDIV,SCTEAM,SCPOS,SCLINIC,SCTP0,SCX
+5 SET SCTP0=$GET(^SCTM(404.57,+SCTP,0))
if '$LENGTH(SCTP0)
QUIT
+6 SET SCX=$PIECE(SCTP0,U)
if '$LENGTH(SCX)
QUIT
+7 SET SCPOS=SCX_U_SCTP
+8 SET SCTEAM=$PIECE(SCTP0,U,2)
if '$$TMDV^SCRPO1(.SCTEAM,.SCDIV)
QUIT
+9 SET SCLINIC=$PIECE(SCTP0,U,9)
if '$$TPCL^SCRPO1(.SCLINIC)
QUIT
+10 DO BTPOS(SCTP,SCDIV,SCTEAM,SCPOS,SCLINIC,SCFMT)
+11 QUIT
+12 ;
BTPOS(SCTP,SCDIV,SCTEAM,SCPOS,SCLINIC,SCFMT) ;Build from team position
+1 ;Input: SCTP=team position ifn
+2 ;Input: SCDIV=division^ifn
+3 ;Input: SCTEAM=team^ifn
+4 ;Input: SCPOS=team position^ifn
+5 ;Input: SCLINIC=associated clinic^ifn (if one exists)
+6 ;Input: SCFMT=report format (detail or summary)
+7 ;
+8 NEW SCARR,SCDT,SCI,SCPASS,ERR
+9 SET SCARR="^TMP(""SCARR"",$J,1)"
KILL @SCARR
+10 MERGE SCDT=^TMP("SC",$JOB,"DTR")
SET SCDT="SCDT"
+11 SET SCI=$$PRTP^SCAPMC(SCTP,.SCDT,SCARR,"ERR",0,0)
SET SCI=0
+12 FOR
SET SCI=$ORDER(^TMP("SCARR",$JOB,1,SCI))
if 'SCI
QUIT
Begin DoDot:1
+13 SET SCPASS=^TMP("SCARR",$JOB,1,SCI)
+14 DO BPRPA^SCRPO4(SCPASS,SCDIV,SCTEAM,SCPOS,SCLINIC,SCFMT)
+15 QUIT
End DoDot:1
+16 QUIT
+17 ;
+1 NEW SCI
+2 FOR SCI=1:1:80
WRITE !
if $Y>(IOSL-9)
QUIT
+3 WRITE !,SCLINE
+4 WRITE !,"NOTE: This report reflects a count of all unique patients assigned to Primary Care and non-Primary Care within the date range"
+5 WRITE !?6,"selected. If a date range larger than one day has been selected, the total patients assigned to a provider may be greater"
+6 WRITE !?6,"than the maximum defined for the position. However, this does not imply that the provider had more than their maximum"
+7 WRITE !?6,"number of patients on any single date."
+8 WRITE !,SCLINE
+9 QUIT
+10 ;
+1 NEW SCI
+2 FOR SCI=1:1:80
WRITE !
if $Y>(IOSL-8)
QUIT
+3 WRITE !,SCLINE
+4 WRITE !,"NOTE: Although presented by division and team, the maximum patients allowed, assigned patients, open slots and precepted patients"
+5 WRITE !?6,"reflected in this summary represent a sum of those categories for the provider position assignments identified within the"
+6 WRITE !?6,"user specified parameters of this report and may not match the maximum patients, etc. defined for the team as a whole."
+7 WRITE !,SCLINE
+8 QUIT
