Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCRPO3

SCRPO3.m

Go to the documentation of this file. 
  1. SCRPO3 ;BP-CIOFO/KEITH - Historical Provider Position Assignment Listing ; 9/14/99 10:06am
  1.  ;;5.3;Scheduling;**177,1015**;AUG 13, 1993;Build 21
  1.  ;
  1. EN ;Queue report
  1.  N LIST,SORT,RTN,DESC,SCSP
  1.  S LIST="DIV,TEAM,POS,ASPR,CLINIC",SORT="DV,TM,TP,PR,EC",SCSP="PR"
  1.  S RTN="RUN^SCRPO3"
  1.  S DESC="Historical Provider Position Assignment Listing"
  1.  D PROMPT^SCRPO1(LIST,SORT,SCSP,RTN,DESC) Q
  1.  ;
  1. RUN ;Print report
  1.  N SCFMT,SCTITL,SCTITL2,SCLINE,SCPAGE,SCOUT,SCFF,SCX,SCPNOW,SCFD
  1.  N SC1,SC2,SC3,SC4,SC5,SC6,SCN,SCI,SCPNOW,SCY,SCFF,SCLINE,SCPAGE
  1.  S SCFMT=$E(^TMP("SC",$J,"FMT")),(SCFF,SCOUT)=0
  1.  D BUILD(SCFMT) Q:SCOUT  S SCI=0
  1.  D HINI D:$E(IOST)="C" DISP0^SCRPW23
  1.  ;print report parameters
  1.  S SCTITL(2)=$$HDRX("P") D HDR^SCRPO(.SCTITL,132) Q:SCOUT  S SCOUT=$$PPAR^SCRPO(.SC,,.SCTITL)=0
  1.  Q:SCOUT
  1.  ;print negative report
  1.  I '$D(^TMP("SCRPT",$J,0)) D  G EXIT
  1.  .K SCTITL(2) D HDR^SCRPO(.SCTITL,132) Q:SCOUT
  1.  .S SCX="No provider position assignments found within selected report parameters!"
  1.  .W !!?(132-$L(SCX)\2),SCX
  1.  .Q
  1.  S SCPAGE=1
  1.  ;print detailed report
  1.  I SCFMT="D" S SCTITL(2)=$$HDRX("D") D HDR^SCRPO(.SCTITL,132),SHDR("D") Q:SCOUT  D
  1.  .S SC1=""
  1.  .F  S SC1=$O(^TMP("SCRPT",$J,1,SC1)) Q:SC1=""!SCOUT  D
  1.  ..S SC2=""
  1.  ..F  S SC2=$O(^TMP("SCRPT",$J,1,SC1,SC2)) Q:SC2=""!SCOUT  D
  1.  ...S SC3=""
  1.  ...F  S SC3=$O(^TMP("SCRPT",$J,1,SC1,SC2,SC3)) Q:SC3=""!SCOUT  D
  1.  ....S SCN=^TMP("SCRPT",$J,1,SC1,SC2,SC3),SC4=""
  1.  ....F  S SC4=$O(^TMP("SCRPT",$J,2,SCN,SC4)) Q:SC4=""!SCOUT  D
  1.  .....S SC5=""
  1.  .....F  S SC5=$O(^TMP("SCRPT",$J,2,SCN,SC4,SC5)) Q:SC5=""!SCOUT  D
  1.  ......S SC6=""
  1.  ......F  S SC6=$O(^TMP("SCRPT",$J,2,SCN,SC4,SC5,SC6)) Q:SC6=""!SCOUT  D
  1.  .......S SCX=^TMP("SCRPT",$J,2,SCN,SC4,SC5,SC6)
  1.  .......I $Y>(IOSL-11) D FOOT1,HDR^SCRPO(.SCTITL,132),SHDR("D") Q:SCOUT
  1.  .......S SCY="0^21^41^46^67^86^94^102^110^118^126" W !
  1.  .......F SCI=1:1:5 W ?($P(SCY,U,SCI)),$P(SCX,U,SCI)
  1.  .......F SCI=6:1:11 W ?($P(SCY,U,SCI)),$J($P(SCX,U,SCI),6,0)
  1.  ......Q
  1.  .....Q
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .D:'SCOUT FOOT1
  1.  .Q
  1.  G:SCOUT EXIT
  1.  ;print summary report
  1.  S SCTITL(2)=$$HDRX("S") D HDR^SCRPO(.SCTITL,132),SHDR("S") G:SCOUT EXIT
  1.  S (SCFD,SCDIV)=0
  1.  F  S SCDIV=$O(^TMP("SCRPT",$J,0,SCDIV)) Q:SCDIV=""!SCOUT  D
  1.  .S SCPC=$S($D(^TMP("SCRPT",$J,0,SCDIV,"PC")):"YES",1:"NO")
  1.  .S SCX=^TMP("SCRPT",$J,0,SCDIV)
  1.  .D:$Y>(IOSL-11) FOOT2,HDR^SCRPO(.SCTITL,132),SHDR("S") Q:SCOUT
  1.  .W:SCFD ! D SLINE(SCDIV,SCPC,SCX) S SCTEAM="",SCFD=1
  1.  .F  S SCTEAM=$O(^TMP("SCRPT",$J,0,SCDIV,1,SCTEAM)) Q:SCTEAM=""!SCOUT  D
  1.  ..S SCPC=$S($D(^TMP("SCRPT",$J,0,SCDIV,1,SCTEAM,"PC")):"YES",1:"NO")
  1.  ..S SCX=^TMP("SCRPT",$J,0,SCDIV,1,SCTEAM)
  1.  ..D:$Y>(IOSL-10) FOOT2,HDR^SCRPO(.SCTITL,132),SHDR("S") Q:SCOUT
  1.  ..D SLINE("  "_SCTEAM,SCPC,SCX)
  1.  ..Q
  1.  .Q
  1.  G:SCOUT EXIT
  1.  ;bp/djb Stop displaying PC? on Total line
  1.  ;Old code begin
  1.  ;S SCPC=$S($D(^TMP("SCRPT",$J,0,0,"PC")):"YES",1:"NO")
  1.  ;Old code end
  1.  ;New code begin
  1.  S SCPC=""
  1.  ;New code end
  1.  S SCX=^TMP("SCRPT",$J,0,0)
  1.  W ! D SLINE("REPORT TOTAL:",SCPC,SCX)
  1.  D FOOT2
  1.  ;
  1. EXIT I $E(IOST)="C",'$G(SCOUT) W ! N DIR S DIR(0)="E" D ^DIR
  1.  F SCI="SC","SCARR","SCRPT" K ^TMP(SCI,$J)
  1.  K SC D END^SCRPW50 Q
  1.  ;
  1. SLINE(SCNAME,SCPC,SCX) ;Print report summary line
  1.  ;Input: SCNAME=division or team name to print
  1.  ;Input: SCPC=primary care y/n
  1.  ;Input: SCX=slot/assignment data
  1.  ;
  1.  W !?22,$P(SCNAME,U),?56,SCPC
  1.  F SCI=1:1:6 W ?(53+(8*SCI)),$J($P(SCX,U,SCI),6,0)
  1.  Q
  1.  ;
  1. HINI ;Initialize header variables
  1.  N Y
  1.  S SCTITL(1)="<*>  HISTORICAL PROVIDER POSITION ASSIGNMENT LISTING  <*>"
  1.  S SCLINE="",$P(SCLINE,"-",133)="",SCPAGE=1
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S SCPNOW=$P(Y,":",1,2)
  1.  Q
  1.  ;
  1. SHDR(SCX) ;Print report subheader
  1.  ;Input: SCX='D' for detail, 'S' for summary
  1.  Q:SCOUT
  1.  I SCX="S" D  Q
  1.  .W !?63,"Max.",?69,"---Assigned---",?93,"---Precepted--"
  1.  .W !?22,"Division",?63,"Pts.",?69,"---Patients---",?87,"Open"
  1.  .W ?93,"---Patients---",!?24,"Team",?56,"PC?  Allow.  PC"
  1.  .W ?77,"Non-PC   Slots  PC      Non-PC"
  1.  .W !?22,"--------------------------------  ---  ------  ------  ------  ------  ------  ------"
  1.  .Q
  1.  W !?88,"Max.  ---Assigned---",?118,"---Precepted--",!
  1.  W ?88,"Pts.  ---Patients---    Open  ---Patients---",!,"Provider Name"
  1.  W ?21,"Position",?41,"PC?  Team",?67,"Associated Clinic"
  1.  W ?86,"Allow.  PC      Non-PC   Slots  PC      Non-PC"
  1.  W !,"-------------------  ------------------  ---  -------------------  -----------------  ------  ------  ------  ------  ------  ------"
  1.  Q
  1.  ;
  1. HDRX(SCX) ;extra header line
  1.  ;Input: SCX='P' for parameters, 'D' for detail, 'S' for summary
  1.  Q:SCX="P" "Selected Report Parameters"
  1.  Q $S(SCX="D":"Detail",1:"Summary")_" for Provider Position Assignments Effective: "_^TMP("SC",$J,"DTR","PBDT")_" to "_^TMP("SC",$J,"DTR","PEDT")
  1.  ;
  1. STOP ;Check for stop task request
  1.  S:$D(ZTQUEUED) (SCOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
  1.  ;
  1. BUILD(SCFMT) ;Build report data
  1.  ;Input: SCFMT=report format (detail or summary)
  1.  N SCTM,SCTP,SCPR,SCARR,ERR,SCI
  1.  ;Build from provider list
  1.  I $O(^TMP("SC",$J,"ASPR",0)) S SCPR=0 D  Q
  1.  .F  S SCTP=$O(^TMP("SC",$J,"ASPR",SCPR)) Q:'SCPR!SCOUT  D
  1.  ..D STOP Q:SCOUT
  1.  ..M SCDT=^TMP("SC",$J,"DTR") S SCDT="SCDT"
  1.  ..S SCARR="^TMP(""SCARR"",$J,1)" K @SCARR
  1.  ..S SCI=$$TPPR^SCAPMC(SCPR,.SCDT,,,SCARR,"ERR")
  1.  ..S SCTM=0 F  S SCTM=$O(^TMP("SCARR",$J,1,"SCTP",SCTM)) Q:'SCTM  D
  1.  ...S SCTP=0 F  S SCTP=$O(^TMP("SCARR",$J,1,"SCTP",SCTM,SCTP)) Q:'SCTP  D
  1.  ....S ^TMP("SCARR",$J,0,SCTP)=""
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .S SCTP=0 F  S SCTP=$O(^TMP("SCARR",$J,0,SCTP)) Q:'SCTP!SCOUT  D
  1.  ..D CKPOS(SCTP,SCFMT),STOP
  1.  ..Q
  1.  .Q
  1.  ;Build from position list
  1.  I $O(^TMP("SC",$J,"POS",0)) S SCTP=0 D  Q
  1.  .F  S SCTP=$O(^TMP("SC",$J,"POS",SCTP)) Q:'SCTP!SCOUT  D
  1.  ..D CKPOS(SCTP,SCFMT),STOP
  1.  ..Q
  1.  .Q
  1.  ;Build from all positions
  1.  S SCTP=0 F  S SCTP=$O(^SCTM(404.57,SCTP)) Q:'SCTP!SCOUT  D
  1.  .D CKPOS(SCTP,SCFMT),STOP
  1.  .Q
  1.  Q
  1.  ;
  1. CKPOS(SCTP,SCFMT) ;Check team position
  1.  ;Input: SCTP=TEAM POSITION ifn
  1.  ;Input: SCFMT=report format (detail or summary)
  1.  ;
  1.  N SCDIV,SCTEAM,SCPOS,SCLINIC,SCTP0,SCX
  1.  S SCTP0=$G(^SCTM(404.57,+SCTP,0)) Q:'$L(SCTP0)
  1.  S SCX=$P(SCTP0,U) Q:'$L(SCX)
  1.  S SCPOS=SCX_U_SCTP
  1.  S SCTEAM=$P(SCTP0,U,2) Q:'$$TMDV^SCRPO1(.SCTEAM,.SCDIV)
  1.  S SCLINIC=$P(SCTP0,U,9) Q:'$$TPCL^SCRPO1(.SCLINIC)
  1.  D BTPOS(SCTP,SCDIV,SCTEAM,SCPOS,SCLINIC,SCFMT)
  1.  Q
  1.  ;
  1. BTPOS(SCTP,SCDIV,SCTEAM,SCPOS,SCLINIC,SCFMT) ;Build from team position
  1.  ;Input: SCTP=team position ifn
  1.  ;Input: SCDIV=division^ifn
  1.  ;Input: SCTEAM=team^ifn
  1.  ;Input: SCPOS=team position^ifn
  1.  ;Input: SCLINIC=associated clinic^ifn (if one exists)
  1.  ;Input: SCFMT=report format (detail or summary)
  1.  ;
  1.  N SCARR,SCDT,SCI,SCPASS,ERR
  1.  S SCARR="^TMP(""SCARR"",$J,1)" K @SCARR
  1.  M SCDT=^TMP("SC",$J,"DTR") S SCDT="SCDT"
  1.  S SCI=$$PRTP^SCAPMC(SCTP,.SCDT,SCARR,"ERR",0,0),SCI=0
  1.  F  S SCI=$O(^TMP("SCARR",$J,1,SCI)) Q:'SCI  D
  1.  .S SCPASS=^TMP("SCARR",$J,1,SCI)
  1.  .D BPRPA^SCRPO4(SCPASS,SCDIV,SCTEAM,SCPOS,SCLINIC,SCFMT)
  1.  .Q
  1.  Q
  1.  ;
  1. FOOT1 ;Detail report footer
  1.  N SCI
  1.  F SCI=1:1:80 W ! Q:$Y>(IOSL-9)
  1.  W !,SCLINE
  1.  W !,"NOTE: This report reflects a count of all unique patients assigned to Primary Care and non-Primary Care within the date range"
  1.  W !?6,"selected.  If a date range larger than one day has been selected, the total patients assigned to a provider may be greater"
  1.  W !?6,"than the maximum defined for the position.  However, this does not imply that the provider had more than their maximum"
  1.  W !?6,"number of patients on any single date."
  1.  W !,SCLINE
  1.  Q
  1.  ;
  1. FOOT2 ;Summary report footer
  1.  N SCI
  1.  F SCI=1:1:80 W ! Q:$Y>(IOSL-8)
  1.  W !,SCLINE
  1.  W !,"NOTE: Although presented by division and team, the maximum patients allowed, assigned patients, open slots and precepted patients"
  1.  W !?6,"reflected in this summary represent a sum of those categories for the provider position assignments identified within the"
  1.  W !?6,"user specified parameters of this report and may not match the maximum patients, etc. defined for the team as a whole."
  1.  W !,SCLINE
  1.  Q