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

SCRPW72.m

Go to the documentation of this file. 
  1. SCRPW72 ;BP-CIOFO/KEITH,ESW - Clinic appointment availability extract (cont.) ; 5/23/03 12:16pm
  1.  ;;5.3;Scheduling;**192,206,223,241,249,291,1015**;AUG 13, 1993;Build 21
  1.  ;
  1. START ;Gather data for printed report
  1.  N SDCP,SC,SCNA,SDI,SDOUT,SDPAST,SDXM,MAX,X1,X2,X,SDIOM,SDFOOT
  1.  I $E(IOST)="C" D WAIT^DICD
  1.  S (SDOUT,SDI)=0,SDIOM=$G(IOM,80)
  1.  S SDPAST=SDBDT'>DT S:SDPAST SDIOM=130
  1.  D HINI^SCRPW76,FOOT^SCRPW77(.SDFOOT)
  1.  K ^TMP("SD",$J),^TMP("SDS",$J),^TMP("SDTMP",$J),^TMP("SDTOT",$J)
  1.  I $G(SDREPORT(4)) K ^TMP("SDPLIST",$J)
  1.  I $G(SDREPORT(5)) D
  1.  .N CC F CC="SDIPLST","SDIP","SDORD" K ^TMP(CC,$J)
  1.  D INIT^SCRPW71 S SDCOL=$S(SDPAST:0,1:(SDIOM-58\2))
  1.  S X1=SDEDT,X2=SDBDT D ^%DTC S MAX=X+1
  1.  I SDPAST I '$G(SDREPORT(5)) D OE(SDBDT,SDEDT,MAX,0) Q:SDOUT  ;get outpt. enc. workload
  1.  G:SDOUT EXIT^SCRPW74
  1.  I $G(SDFMT)="D"!($G(SDFMTS)="CP") D
  1.  .I $G(SDREPORT(5)) D CA(.SDSORT) Q
  1.  .D @SDSORT
  1.  I $G(SDFMT)="S"&($G(SDFMTS)'="CP") S SC=0 F  S SC=$O(^SC(SC)) Q:'SC!SDOUT  D
  1.  .S SDI=SDI+1 I SDI#25=0 D STOP Q:SDOUT
  1.  .S SC0=$G(^SC(SC,0)) Q:'$$DIV(+$P(SC0,U,15))
  1.  .S SDX=$$CLINIC^SCRPW71(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
  1.  G:SDOUT EXIT^SCRPW74
  1.  S SDMD=$O(^TMP("SD",$J,"")),SDMD=$O(^TMP("SD",$J,SDMD)),SDMD=$L(SDMD)
  1.  I SDPAST D NAVA^SCRPW75(SDBDT,SDEDT,SDEX)  ;get next available wait times
  1.  G:SDOUT EXIT^SCRPW74
  1.  D ORD
  1.  I $E(IOST)="C" D END^SCRPW50
  1.  S SDREPORT=0 F  S SDREPORT=$O(SDREPORT(SDREPORT)) Q:SDOUT!'SDREPORT  D
  1.  .I SDREPORT(SDREPORT) S SDPAGE=1 D PRT^SCRPW73(0,SDREPORT)
  1.  G EXIT^SCRPW74
  1.  ;
  1. ORD ;Build list to order clinic output
  1.  S SDIV="" F  S SDIV=$O(^TMP("SD",$J,SDIV)) Q:SDIV=""!SDOUT  D
  1.  .S SDCP=0 F  S SDCP=$O(^TMP("SD",$J,SDIV,SDCP)) Q:'SDCP!SDOUT  D
  1.  ..S SC=0 F  S SC=$O(^TMP("SD",$J,SDIV,SDCP,SC)) Q:'SC!SDOUT  D
  1.  ...S SCNA=$P($G(^SC(SC,0)),U) S:'$L(SCNA) SCNA="UNKNOWN"
  1.  ...S ^TMP("SDS",$J,SDCP,SCNA,SC)=""
  1.  Q
  1.  ;
  1. OE(SDBDT,SDEDT,MAX,SDEX) ;Count clinic workload
  1.  ;Input: SDBDT=begin date
  1.  ;Input: SDEDT=end date
  1.  ;Input: MAX=number of days in date range
  1.  ;Input: SDEX='0' for user report, '1' for Austin extract
  1.  N SDT,SDOE,SDOE0,SDCT,SDCP,SDQUIT,SDAY,DFN
  1.  S (SDQUIT,SDCT)=0,SDT=SDBDT
  1.  F  S SDT=$O(^SCE("B",SDT)) Q:'SDT!(SDT>SDEDT)!SDOUT  D
  1.  .S SDOE=0 F  S SDOE=$O(^SCE("B",SDT,SDOE)) Q:'SDOE!SDOUT  D
  1.  ..S SDCT=SDCT+1 I SDCT#1000=0 D STOP Q:SDOUT
  1.  ..S SDOE0=$$GETOE^SDOE(SDOE) Q:$P(SDOE0,U,6)  Q:$P(SDOE0,U,12)=12
  1.  ..S DFN=$P(SDOE0,U,2) Q:'DFN
  1.  ..Q:$E($P($G(^DPT(DFN,0)),U,9),1,5)="00000"  ;exclude test patients
  1.  ..S SC=$P(SDOE0,U,4) Q:'SC  Q:'$$DIV(+$P(SDOE0,U,11))
  1.  ..S SC0=$G(^SC(SC,0)) Q:'$L($P(SC0,U))
  1.  ..Q:$P(SC0,U,17)="Y"  Q:'$$CPAIR^SCRPW71(SC0,.SDCP)
  1.  ..I 'SDEX,$D(SDSORT) S SDQUIT=0 D  Q:SDQUIT
  1.  ...I SDSORT="CL"!(SDSORT="CA"),'$D(SDSORT($P(SC0,U))) S SDQUIT=1 Q
  1.  ...I SDSORT="CP",'$D(SDSORT(SDCP)) S SDQUIT=1
  1.  ..S SDIV=$$DIV^SCRPW71(SC0) Q:'$L(SDIV)
  1.  ..I '$D(^TMP("SD",$J,SDIV,SDCP,SC)) D ARRINI^SCRPW71(SDCP,SC,MAX,SDPAST)
  1.  ..S $P(^TMP("SD",$J,SDIV,SDCP),U,3)=$P(^TMP("SD",$J,SDIV,SDCP),U,3)+1
  1.  ..S $P(^TMP("SD",$J,SDIV,SDCP,SC),U,3)=$P(^TMP("SD",$J,SDIV,SDCP,SC),U,3)+1
  1.  ..Q:SDFMT'="D"  S X1=$P(SDT,"."),X2=SDBDT D ^%DTC S SDAY=X+1
  1.  ..D ARRSET(SDCP,SC,SDAY) Q
  1.  Q
  1.  ;
  1. ARRSET(SDCP,SC,SDI) ;Set daily counts into array
  1.  ;Input: SDCP=credit pair
  1.  ;Input: SC=clinic ifn
  1.  ;Input: SDI=number of days from report date
  1.  N SDS,SDP,SDX
  1.  S SDS=SDI-1\12,SDP=SDI#12 S:SDP=0 SDP=12
  1.  S SDX=$P(^TMP("SD",$J,SDIV,SDCP,SC,SDS),U,SDP)
  1.  S:'$L(SDX) SDX="0~0~0"
  1.  S $P(SDX,"~",3)=$P(SDX,"~",3)+1
  1.  S $P(^TMP("SD",$J,SDIV,SDCP,SC,SDS),U,SDP)=SDX
  1.  Q
  1.  ;
  1. DIV(SDIV) ;Evaluate division
  1.  Q:'SDDIV 1  Q $D(SDDIV(SDIV))
  1.  ;
  1. CA(SORT) ;Evaluate list of clinics for selected patient
  1.  N SDCNAM,SC0,SDIV,XX,DFN,SDIV,SDCP,SDPNAME S SDI=0
  1.  F XX=1:1:$G(SDPAT) S DFN=+^TMP("SDPAT",SDJN,XX),SDPNAME=$P(^(XX),U,2)  D
  1.  .N SDDT S SDDT=SDBDT-1+.9999999 ; DATE/TIME APPT SCHEDULED 
  1.  .F  S SDDT=$O(^DPT(DFN,"S",SDDT)) Q:'SDDT!(SDDT>SDEDT)  D
  1.  ..S SDI=SDI+1 I SDI#10=0 D STOP Q:SDOUT
  1.  ..S SC=+^DPT(DFN,"S",SDDT,0),SC0=$G(^SC(SC,0)) I '$$DIV(+$P(SC0,U,15)) Q
  1.  ..Q:$P(SC0,U,17)="Y"  ;non-count clinic
  1.  ..S SDIV=$$DIV^SCRPW71(SC0)
  1.  ..I '$$CPAIR^SCRPW71(SC0,.SDCP) Q
  1.  ..I $G(SORT)="CP",'$D(SORT(SDCP)) Q  ;selection by credit pairs
  1.  ..I $G(SORT)="CL",'$D(SORT($P(SC0,U))) Q  ; selection by list of clinics
  1.  ..I $G(SDREPORT(5)) S ^TMP("SDIPLST",$J,DFN,SC)="",^TMP("SDIP",$J,$P(SDIV,U,2),SC)=SDCP_U_$P(SDIV,U),^TMP("SDORD",$J,SDPNAME,DFN)=""
  1.  ..S SDX=$$CLINIC^SCRPW71(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
  1.  Q
  1. CL ;Evaluate list of clinics
  1.  N SDCNAM,SC0,SDIV S SDI=0
  1.  S SDCNAM="" F  S SDCNAM=$O(SDSORT(SDCNAM)) Q:SDCNAM=""!SDOUT  D
  1.  .S SDI=SDI+1 I SDI#10=0 D STOP Q:SDOUT
  1.  .S SC=SDSORT(SDCNAM),SC0=$G(^SC(SC,0)) Q:'$$DIV(+$P(SC0,U,15))
  1.  .I $G(SDREPORT(4)) S ^TMP("SDPLIST",$J,SC)=""
  1.  .S SDX=$$CLINIC^SCRPW71(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
  1.  .I $P(SDX,U,3)=-1 D
  1.  ..S SDIV=$$DIV^SCRPW71(SC0)
  1.  ..S:$L(SDIV) $P(^TMP("SD",$J,SDIV,SDCNAM),U,3)=$P(SDX,U,3,4) Q
  1.  Q
  1.  ;
  1. CP ;Evaluate list of credit pairs
  1.  N SDCCP,SC,SC0 S SC=0
  1.  F  S SC=$O(^SC(SC)) Q:'SC!SDOUT  D
  1.  .S SC0=$G(^SC(SC,0)) Q:'$$DIV(+$P(SC0,U,15))
  1.  .Q:'$$CPAIR^SCRPW71(SC0,.SDCCP)!'$D(SDSORT(SDCCP))
  1.  .I $G(SDREPORT(4)) S ^TMP("SDPLIST",$J,SC)=""
  1.  .S SDX=$$CLINIC^SCRPW71(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
  1.  Q
  1.  ;
  1. CNAME(SC) ;Massage clinic name
  1.  N SDX
  1.  ;Default name value
  1.  S SDX=$P($G(^SC(SC,0)),U) Q:'$L(SDX) "UNKNOWN"
  1.  ;Remove extract formatting characters
  1.  S SDX=$TR(SDX,"#$^~|")
  1.  ;Uppercase name value
  1.  S SDX=$TR(SDX,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1.  Q SDX
  1.  ;
  1. SORT(SDSORT) ;Gather sort values for detailed report
  1.  ;Input: SDSORT=sort category (pass by reference)
  1.  ;Output: '1' if selection(s) made, '0' otherwise
  1.  ;        SDSORT(clinic name)=clinic ifn 
  1.  ;                    (or)
  1.  ;        SDSORT(credit pair)=credit pair
  1.  ;
  1.  N SDSX S SDSX="S"_SDSORT
  1.  I SDSORT="CA" Q 1
  1.  D @SDSX Q $D(SDSORT)>1
  1.  ;
  1. SCL ;Select clinics for detail
  1.  N DIC,SDQUIT S (SDQUIT,SDOUT)=0
  1.  S DIC="^SC(",DIC(0)="AEMQ",DIC("A")="Select CLINIC: ",DIC("S")="I $P(^(0),U,3)=""C"""
  1.  W ! F  Q:SDOUT!SDQUIT  D
  1.  .D ^DIC I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q
  1.  .I X="" S SDQUIT=1 Q
  1.  .I Y>0,$L($P(Y,U,2)) S SDSORT($P(Y,U,2))=+Y
  1.  Q
  1.  ;
  1. SCP ;Get credit pairs for detail
  1.  N DIR,SDQUIT S (SDQUIT,SDOUT)=0
  1.  S DIR(0)="NO:101000:999000:0",DIR("A")="Select clinic DSS credit pair"
  1.  S DIR("?",1)="Specify a six digit number that represents the primary and secondary stop"
  1.  S DIR("?",2)="code of clinics you wish to evaluate.  For clinics that do not have a"
  1.  S DIR("?",3)="secondary stop code, enter ""000"" as the second half of the credit pair"
  1.  S DIR("?")="(eg. ""323000"")."
  1.  W ! F  Q:SDOUT!SDQUIT  D
  1.  .D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q
  1.  .I X="" S SDQUIT=1 Q
  1.  .I '$$VCP(Y) W "  Invalid credit pair!" Q
  1.  .S SDSORT(Y)=Y
  1.  Q
  1.  ;
  1. VCP(Y) ;Validate credit pair
  1.  ;Input: Y=credit pair
  1.  ;Output: '1' if valid, '0' otherwise
  1.  Q:Y'?6N 0
  1.  Q:'$D(^DIC(40.7,"C",$E(Y,1,3))) 0
  1.  Q:$E(Y,4,6)="000" 1
  1.  Q:'$D(^DIC(40.7,"C",$E(Y,4,6))) 0
  1.  Q 1
  1.  ;
  1. STOP ;Check for stop task request
  1.  S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
  1.  ;
  1. ADDL(SDZ) ;Format additional data
  1.  ;Input: SDZ=addl. data from ^TMP("SDNAVB",^J,SDCP,SC)
  1.  ;
  1.  N SDI,SDX S SDX=""
  1.  F SDI=1:1:7 S SDX=SDX_$S(SDI=5:"^",1:"~")_+$P(SDZ,U,SDI)
  1.  Q SDX
  1.  ;
  1. EXTRACT ;Gather data for extract
  1.  N SDBEG,SDEND,SDTIME,SDCP,SDX,SDY,SC,SCNA,SDI,SDFMT,SDOUT,SDXM,SDIOM,SDFOOT
  1.  N SDEXDT,MAX,X1,X2,X S SDIOM=$G(IOM,80)
  1.  F SDI=1,2,3 S SDREPORT(SDI)=1
  1.  S (SDOUT,SDCOL)=0,SDFMT="D",SDBEG=$H,SDEXDT=DT D INIT^SCRPW71
  1.  K ^TMP("SD",$J),^TMP("SDS",$J),^TMP("SDTMP",$J),^TMP("SDXM",$J)
  1.  S X1=SDEDT,X2=SDBDT D ^%DTC S MAX=X+1
  1.  D HINI^SCRPW76,FOOT^SCRPW77(.SDFOOT)
  1.  ;
  1.  ;Get encounter workload
  1.  I SDPAST D OE(SDBDT,SDEDT_.9999,MAX,1)  ;encounter workload
  1.  ;
  1.  ;Get clinic availability data
  1.  S SC=0 F  S SC=$O(^SC(SC)) Q:'SC  S SC0=$G(^SC(SC,0)) D
  1.  .S SDX=$$CLINIC^SCRPW71(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
  1.  ;
  1.  ;Get next available wait times
  1.  S SDMD=$O(^TMP("SD",$J,"")),SDMD=$O(^TMP("SD",$J,SDMD)),SDMD=$L(SDMD)
  1.  I SDPAST D NAVA^SCRPW75(SDBDT,SDEDT_.9999,1)  ;next ava. wait times
  1.  ;
  1.  ;Order by clinic, send extract data to Austin
  1.  D ORD,TXXM^SCRPW70 K ^TMP("SDXM",$J)
  1.  ;
  1.  ;Send summary bulletin to mail group
  1.  S SDFMT="S",SDEND=$H,SDTIME=$$TIME(SDBEG,SDEND)
  1.  S SDBEG=$$HTE^XLFDT(SDBEG),SDEND=$$HTE^XLFDT(SDEND)
  1.  S SDY="*** Clinic Appointment "_$S(SDPAST:"Utilization",1:"Availability")_" Extract ***"
  1.  S SDXM=1,SDX="",$E(SDX,(79-$L(SDY)\2))=SDY D XMTX^SCRPW73(SDX)
  1.  D XMTX^SCRPW73(" ")
  1.  D XMTX^SCRPW73("                   For date range: "_SDPBDT_" to "_SDPEDT)
  1.  D XMTX^SCRPW73("               Extract start time: "_SDBEG)
  1.  D XMTX^SCRPW73("                 Extract end time: "_SDEND)
  1.  D XMTX^SCRPW73("                 Extract run time: "_SDTIME)
  1.  D XMTX^SCRPW73("                      Task number: "_$G(ZTSK))
  1.  F SDI=1:1:4 D XMTX^SCRPW73("")
  1.  D PRT^SCRPW73(SDXM,1),EXXM^SCRPW70("G.SC CLINIC WAIT TIME")
  1.  I SDPAST F SDI=2,3 D
  1.  .K ^TMP("SDXM",$J) S SDXM=1
  1.  .D PRT^SCRPW73(SDXM,SDI),EXXM^SCRPW70("G.SC CLINIC WAIT TIME")
  1.  G EXIT^SCRPW74
  1.  ;
  1. TIME(SDBEG,SDEND) ;Calculate length of run time
  1.  ;Input: SDBEG=start time in $H format
  1.  ;Input: SDEND=end time in $H format
  1.  ;Output: text formatted string with # days, hours, minutes and seconds
  1.  N X,Y
  1.  S SDEND=$P(SDEND,",")-$P(SDBEG,",")*86400+$P(SDEND,",",2)
  1.  S SDBEG=$P(SDBEG,",",2),X=SDEND-SDBEG,Y("D")=X\86400
  1.  S X=X#86400,Y("H")=X\3600,X=X#3600,Y("M")=X\60,Y("S")=X#60
  1.  S Y("D")=$S('Y("D"):"",1:Y("D")_" day"_$S(Y("D")=1:"",1:"s")_", ")
  1.  S Y("H")=Y("H")_" hour"_$S(Y("H")=1:"",1:"s")_", "
  1.  S Y("M")=Y("M")_" minute"_$S(Y("M")=1:"",1:"s")_", "
  1.  S Y("S")=Y("S")_" second"_$S(Y("S")=1:"",1:"s")
  1.  Q Y("D")_Y("H")_Y("M")_Y("S")