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

SCRPO6.m

Go to the documentation of this file. 
  1. SCRPO6 ;BP-CIOFO/KEITH - Historical Team Assignment Summary ; 9/14/99 10:07am
  1.  ;;5.3;Scheduling;**177,297**;AUG 13, 1993
  1.  ;
  1. EN ;Queue report
  1.  N LIST,RTN,DESC
  1.  S SUMON=0
  1.  W !,"Print Final Summary Only" S %=2 D YN^DICN I %=1 S SUMON=1
  1.  S LIST="DIV,TEAM"
  1.  S RTN="RUN^SCRPO6"
  1.  S DESC="Historical Team Assignment Summary"
  1.  D PROMPT(LIST,RTN,DESC) Q
  1.  ;
  1. PROMPT(LIST,SCRTN,SCDESC) ;Prompt for report parameters, queue report
  1.  ;Input: LIST=comma delimited string of list subscripts to prompt for
  1.  ;Input: SCRTN=report routine entry point
  1.  ;Input: SCDESC=tasked job description
  1.  ;
  1.  N SCDIV,SCBDT,SCEDT,SC,SCI,SCX,SCOUT,SCT
  1.  S SC="^TMP(""SC"",$J)" K @SC S SCOUT=0
  1.  D TITL^SCRPW50(SCDESC)
  1.  D SUBT^SCRPW50("**** Date Range Selection ****")
  1.  S (SCBDT("B"),SCEDT("B"))="TODAY"
  1.  G:'$$DTR^SCRPO(.SC,.SCBDT,.SCEDT) END
  1.  D SUBT^SCRPW50("**** Report Parameter Selection ****")
  1.  F SCI=1:1:$L(LIST,",") S SCX=$P(LIST,",",SCI) D  Q:SCOUT
  1.  .S SCOUT='$$LIST^SCRPO(.SC,SCX,1)
  1.  .Q
  1.  G:SCOUT END
  1.  S SCT(1)="**** Report Parameters Selected ****" D SUBT^SCRPW50(SCT(1))
  1.  G:'$$PPAR^SCRPO(.SC,1,.SCT) END
  1.  W !!,"This report requires 132 column output!"
  1.  W ! N ZTSAVE S ZTSAVE("^TMP(""SC"",$J,")="",ZTSAVE("SC")="",ZTSAVE("SUMON")=""
  1.  D EN^XUTMDEVQ(SCRTN,SCDESC,.ZTSAVE)
  1. END K ^TMP("SC",$J) D DISP0^SCRPW23,END^SCRPW50 Q
  1.  ;
  1. STOP ;Check for stop task request
  1.  S:$D(ZTQUEUED) (SCOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
  1.  ;
  1. RUN ;Print report
  1.  N SCI,SCOUT
  1.  K ^TMP("SCRPT",$J)
  1.  S SCOUT=0
  1.  D BUILD Q:SCOUT  D COUNT^SCRPO7 D STOP Q:SCOUT
  1.  D PRINT
  1.  K ^TMP("SCRPT",$J),^TMP("SCRATCH",$J) Q
  1.  ;
  1. BUILD ;gather report information
  1.  N SCTM
  1.  ;build from list of teams
  1.  I $O(^TMP("SC",$J,"TEAM",0)) S SCTM=0 D  Q
  1.  .F  S SCTM=$O(^TMP("SC",$J,"TEAM",SCTM)) Q:'SCTM!SCOUT  D
  1.  ..D CKTEAM^SCRPO7(SCTM),STOP
  1.  ..Q
  1.  .Q
  1.  ;build from all teams
  1.  S SCTM=0 F  S SCTM=$O(^SCTM(404.51,SCTM)) Q:'SCTM!SCOUT  D
  1.  .D CKTEAM^SCRPO7(SCTM),STOP
  1.  .Q
  1.  Q
  1.  ;
  1. PRINT ;Print report
  1.  N SCLF,SCFF,SCLINE,SCPAGE,SCPNOW,SCTITL
  1.  S (SCLF,SCFF)=0
  1.  D HINI D:$E(IOST)="C" DISP0^SCRPW23
  1.  S SCTITL(2)=$$HDRX("P") D HDR^SCRPO(.SCTITL,132) Q:SCOUT  S SCOUT=$$PPAR^SCRPO(.SC,,.SCTITL)=0
  1.  Q:SCOUT
  1.  I '$D(^TMP("SCRPT",$J,0)) D  Q
  1.  .K SCTITL(2) D HDR^SCRPO(.SCTITL,132) Q:SCOUT
  1.  .S SCX="No team or team position assignments found within selected report parameters!"
  1.  .W !!?(132-$L(SCX)\2),SCX
  1.  .Q
  1.  S SCPAGE=1
  1.  S SCTITL(2)=$$HDRX("S") D HDR^SCRPO(.SCTITL,132),SHDR("S") Q:SCOUT
  1.  S SCDIV="" F  S SCDIV=$O(^TMP("SCRPT",$J,1,SCDIV)) Q:SCDIV=""!SCOUT  D
  1.  .S SCX=^TMP("SCRPT",$J,1,SCDIV) D SLINE(SCDIV,SCX,12,.SCLF) S SCTEAM=""
  1.  .F  S SCTEAM=$O(^TMP("SCRPT",$J,1,SCDIV,"TEAM",SCTEAM)) Q:SCTEAM=""!SCOUT  D
  1.  ..S SCX=^TMP("SCRPT",$J,1,SCDIV,"TEAM",SCTEAM)
  1.  ..D SLINE("  "_SCTEAM,SCX,10,.SCLF)
  1.  ..Q
  1.  .Q
  1.  Q:SCOUT
  1.  S SCX=^TMP("SCRPT",$J,0,0) D SLINE("REPORT TOTAL:",SCX,12,.SCLF)
  1.  Q:SCOUT  D FOOT^SCRPO7
  1.  Q:$G(SUMON)
  1.  I $D(^TMP("SCRPT",$J,0,0,"TLIST")) D
  1.  .S SCTITL(2)=$$HDRX("T") D HDR^SCRPO(.SCTITL,132),SHDR("T") Q:SCOUT
  1.  .S SCDIV=""
  1.  .F  S SCDIV=$O(^TMP("SCRPT",$J,0,0,"TLIST",SCDIV)) Q:SCDIV=""!SCOUT  D
  1.  ..S SCTEAM=""
  1.  ..F  S SCTEAM=$O(^TMP("SCRPT",$J,0,0,"TLIST",SCDIV,SCTEAM)) Q:SCTEAM=""!SCOUT  D
  1.  ...S SCPNAM=""
  1.  ...F  S SCPNAM=$O(^TMP("SCRPT",$J,0,0,"TLIST",SCDIV,SCTEAM,SCPNAM)) Q:SCPNAM=""!SCOUT  D
  1.  ....S SCI=0
  1.  ....F  S SCI=$O(^TMP("SCRPT",$J,0,0,"TLIST",SCDIV,SCTEAM,SCPNAM,SCI)) Q:'SCI!SCOUT  D
  1.  .....S SCX=^TMP("SCRPT",$J,0,0,"TLIST",SCDIV,SCTEAM,SCPNAM,SCI)
  1.  .....D TLINE(SCDIV,SCTEAM,SCPNAM,SCX)
  1.  .....Q
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  Q:SCOUT  I $D(^TMP("SCRPT",$J,0,0,"PLIST")) D
  1.  .S SCTITL(2)=$$HDRX("TP") D HDR^SCRPO(.SCTITL,132),SHDR("P") Q:SCOUT
  1.  .S SCDIV=""
  1.  .F  S SCDIV=$O(^TMP("SCRPT",$J,0,0,"PLIST",SCDIV)) Q:SCDIV=""!SCOUT  D
  1.  ..S SCTEAM=""
  1.  ..F  S SCTEAM=$O(^TMP("SCRPT",$J,0,0,"PLIST",SCDIV,SCTEAM)) Q:SCTEAM=""!SCOUT  D
  1.  ...S SCPNAM=""
  1.  ...F  S SCPNAM=$O(^TMP("SCRPT",$J,0,0,"PLIST",SCDIV,SCTEAM,SCPNAM)) Q:SCPNAM=""!SCOUT  D
  1.  ....S SCI=0
  1.  ....F  S SCI=$O(^TMP("SCRPT",$J,0,0,"PLIST",SCDIV,SCTEAM,SCPNAM,SCI)) Q:'SCI!SCOUT  D
  1.  .....S SCX=^TMP("SCRPT",$J,0,0,"PLIST",SCDIV,SCTEAM,SCPNAM,SCI)
  1.  .....D PLINE(SCDIV,SCTEAM,SCPNAM,SCX)
  1.  .....Q
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  I 'SCOUT,$E(IOST)="C" N DIR S DIR(0)="E" W ! D ^DIR
  1.  Q
  1.  ;
  1. SLINE(SCN,SCX,SCPF,SCLF) ;Print summary line
  1.  ;Input: SCN=name of item to print
  1.  ;Input: SCX=string of item values
  1.  ;Input: SCPF=minimum lines without page feed
  1.  ;Input: SCLF=extra line feed flag
  1.  ;
  1.  N SCI,SCY
  1.  S SCY="2^3^7^5^4^9^8^10^6^11^12"
  1.  I $Y>(IOSL-SCPF) D FOOT^SCRPO7,HDR^SCRPO(.SCTITL,132),SHDR("S") S SCLF=0
  1.  Q:SCOUT  W:SCPF>10&SCLF !
  1.  ;bp/djb Omit PC? column from REPORT TOTAL line.
  1.  ;Old code start
  1.  ;W !,$E($P(SCN,U),1,28),?30,$S($P(SCX,U)="":"NO",1:$P(SCX,U))
  1.  ;Old code end
  1.  ;New code start
  1.  I SCN["REPORT TOTAL" W !,$E($P(SCN,U),1,28)
  1.  E  W !,$E($P(SCN,U),1,28),?30,$S($P(SCX,U)="":"NO",1:$P(SCX,U))
  1.  ;New code end
  1.  F SCI=1:1:11 W ?(27+(9*SCI)),$J(+$P(SCX,U,$P(SCY,U,SCI)),6,0)
  1.  S SCLF=1
  1.  Q
  1.  ;
  1. TLINE(SCDIV,SCTEAM,SCPNAM,SCX) ;Print broken team assignment line
  1.  ;Input: SCDIV=division
  1.  ;Input: SCTEAM=team
  1.  ;Input: SCPNAM=patient name
  1.  ;Input: SCX=string of patient assignment data
  1.  ;
  1.  N SCI,Y
  1.  F SCI=3,4 S Y=$P($P(SCX,U,SCI),".") X ^DD("DD") S $P(SCX,U,SCI)=Y
  1.  I $Y>(IOSL-4) D HDR^SCRPO(.SCTITL,132),SHDR("T") Q:SCOUT
  1.  W !,$P(SCDIV,U),?32,$P(SCTEAM,U),?64,SCPNAM
  1.  W ?96,$TR($P(SCX,U,2),"-",""),?108,$P(SCX,U,3),?121,$P(SCX,U,4)
  1.  Q
  1.  ;
  1. PLINE(SCDIV,SCTEAM,SCPNAM,SCX) ;Print broken team assignment line
  1.  ;Input: SCDIV=division
  1.  ;Input: SCTEAM=team
  1.  ;Input: SCPNAM=patient name
  1.  ;Input: SCX=string of patient assignment data
  1.  ;
  1.  N SCI,Y
  1.  F SCI=3,4 S Y=$P($P(SCX,U,SCI),".") X ^DD("DD") S $P(SCX,U,SCI)=Y
  1.  I $Y>(IOSL-4) D HDR^SCRPO(.SCTITL,132),SHDR("P") Q:SCOUT
  1.  W !,$P(SCDIV,U),?24,$P(SCTEAM,U),?48,SCPNAM,?72,$TR($P(SCX,U,2),"-","")
  1.  W ?84,$P(SCX,U,5),?108,$P(SCX,U,3),?121,$P(SCX,U,4)
  1.  Q
  1.  ;
  1. HDRX(SCX) ;extra header line
  1.  ;Input: SCX='P' for parameters, 'S' for summary, 'T' for broken team
  1.  ;            assignments, 'TP' for broken team position assignments
  1.  ;
  1.  Q:SCX="P" "Selected Report Parameters"
  1.  Q:SCX="S" "Summary of Team and Team Position Assignments Effective: "_^TMP("SC",$J,"DTR","PBDT")_" to "_^TMP("SC",$J,"DTR","PEDT")
  1.  Q:SCX="T" "Team Assignments Without Active Position Assignments Effective: "_^TMP("SC",$J,"DTR","PBDT")_" to "_^TMP("SC",$J,"DTR","PEDT")
  1.  Q:SCX="TP" "Position Assignments Without Active Team Assignments Effective: "_^TMP("SC",$J,"DTR","PBDT")_" to "_^TMP("SC",$J,"DTR","PEDT")
  1.  Q:"" 
  1.  ;
  1. HINI ;Initialize header variables
  1.  N Y
  1.  S SCTITL(1)="<*>  HISTORICAL TEAM ASSIGNMENT SUMMARY  <*>"
  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(X) ;Print subheader
  1.  Q:SCOUT
  1.  N SCI
  1.  I X="S" D  Q
  1.  .W !?56,"Team  --Team Position-  --Team Position-    Total",?116,"Pts w/o  Pts w/o"
  1.  .W !,"Division",?38,"Max.     Team  Assign.  ---Assignments--  ---Unique Pts.--   Unique     Open     Pos.     Team"
  1.  .W !?2,"Team",?30,"PC?     Pts.  Assign.  Uniques  PC",?72,"Non-PC  PC",?90,"Non-PC     Pts.    Slots  Assign.  Assign."
  1.  .W !,$E(SCLINE,1,28),"  ---" F SCI=0:1:10 W ?(35+(9*SCI)),"-------"
  1.  .Q
  1.  I X="T" D  Q
  1.  .W !,"Division",?32,"Team",?64,"Patient Name",?96,"SSN",?108,"Active Date",?121,"Inact. Date"
  1.  .W ! F SCI=1:1:3 W $E(SCLINE,1,30),"  "
  1.  .W "----------  -----------  -----------"
  1.  .Q
  1.  I X="P" D  Q
  1.  .W !,"Division",?24,"Team",?48,"Patient Name",?72,"SSN",?84,"Team Position",?108,"Active Date",?121,"Inact. Date"
  1.  .W ! F SCI=1:1:3 W $E(SCLINE,1,22),"  "
  1.  .W "----------  ",$E(SCLINE,1,22),"  -----------  -----------"
  1.  .Q
  1.  Q