SCRPW70 ;BP-CIOFO/KEITH,ESW - Clinic appointment availability extract ; 7/8/03 2:23pm
;;5.3;Scheduling;**192,206,223,241,249,291**;AUG 13, 1993
N SDEX,SDDIV,DIR,SDFMT,SDFMTS,SDMAX,SDSORT,SDOUT,X,Y,DTOUT,DUOUT
N SDREPORT,SDEDT,SDBDT,SDPEDT,SDPBDT,SDPAT,SDPT,SDJN
S SDJN=$J
S (SDEX,SDOUT)=0
D TITL^SCRPW50("Clinic Appointment Availability Report")
I '$$DIVA^SCRPW17(.SDDIV) S SDOUT=1 G EXIT^SCRPW74
D SUBT^SCRPW50("**** Date Range Selection ****")
W ! S %DT="AEX",%DT("A")="Beginning date: " D ^%DT I Y<1 S SDOUT=1 G EXIT^SCRPW74
S SDBDT=Y X ^DD("DD") S SDPBDT=Y
EDT S %DT("A")=" Ending date: " W ! D ^%DT I Y<1 S SDOUT=1 G EXIT^SCRPW74
I Y<SDBDT W !!,$C(7),"End date cannot be before begin date!",! G EDT
S SDEDT=Y_.999999 X ^DD("DD") S SDPEDT=Y
S SDMAX=Y D SUBT^SCRPW50("**** Report Format Selection ***")
S DIR(0)="S^S:SUMMARY FOR DATE RANGE;D:DETAIL BY DAY",DIR("A")="Select report format"
W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 G EXIT^SCRPW74
S SDFMT=Y G:SDFMT="S" REN
;clarification that you may skip entry for a patient
W !!?3,"To generate a detailed report by stop code pair or clinic,"
W !?3,"press 'enter' without inputting a patient name.",!
S SDPAT=0
K ^TMP("SDPAT",SDJN)
D SELECT^SCRPW78(SDJN,.SDPAT) ;select patient(s)
S DIR("B")="CLINIC NAME"
S DIR(0)="S^CL:CLINIC NAME;CP:CREDIT PAIR",DIR("A")="Specify limiting category for detail"
I $G(SDPAT) S DIR("B")="CLINIC ALL",DIR(0)="S^CA:CLINIC ALL;CL:CLINIC NAME;CP:CREDIT PAIR"
S DIR("?")="Indicate if availability should be limited by clinic name or DSS credit pair."
W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 G EXIT^SCRPW74
S SDSORT=Y I '$$SORT^SCRPW72(.SDSORT) S SDOUT=1 G EXIT^SCRPW74
G:SDOUT EXIT^SCRPW74
I SDBDT>DT S SDREPORT(1)=1 G QUE
G RENS
REN I SDBDT>DT S SDREPORT(1)=1 G QUE
S DIR(0)="S^CL:ALL CLINICS;CP:CREDIT PAIR SELECTION",DIR("A")="Specify if all clinics or selected clinics by credit pair"
S DIR("?")="Indicate if availability should include All clinics or clinics selected by DSS credit pair only."
W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 G EXIT^SCRPW74
S SDFMTS=Y I SDFMTS="CP" D G:SDOUT EXIT^SCRPW74
.S SDSORT=Y I '$$SORT^SCRPW72(.SDSORT) S SDOUT=1
G:SDOUT EXIT^SCRPW74
RENS D SUBT^SCRPW50("**** Report Output Section Selection ****")
ROSS S DIR(0)="Y",DIR("B")="YES"
N II F II=1:1:5 S SDREPORT(II)=0
I '$G(SDPAT) D
.S DIR("A")="Include 'next available' appointment statistics"
.W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 D EXIT^SCRPW74 Q
.S SDREPORT(1)=Y
.S DIR("A")="Include 'follow up' appointment statistics"
.W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 D EXIT^SCRPW74 Q
.S SDREPORT(2)=Y
.S DIR("A")="Include 'non-follow up' appointment statistics"
.W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 D EXIT^SCRPW74 Q
.S SDREPORT(3)=Y
.I SDFMT="D" D
..S DIR("A")="Include list of patient appointments"
..W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 D EXIT^SCRPW74 Q
..S SDREPORT(4)=Y
I $G(SDPAT) D
.S DIR("?")="Accept to print report for selected patient(s) or exit"
.S DIR("A")="Print individual patient report" D
.W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 D EXIT^SCRPW74 Q
.S SDREPORT(5)=Y
I '$D(SDREPORT) S SDOUT=1 D EXIT^SCRPW74 Q
I 'SDREPORT(1),'SDREPORT(2),'SDREPORT(3),'SDREPORT(4),'SDREPORT(5) D G ROSS
.W $C(7),!!,"No output elements selected--at least one must be selected to continue..."
QUE I SDBDT'>DT W !!,"This report requires 132 column output!"
N ZTSAVE F X="SDREPORT(","SDEX","SDBDT","SDPBDT","SDEDT","SDPEDT","SDDIV","SDDIV(","SDFMT","SDFMTS","SDSORT","SDSORT(","SDPAT","SDJN","^TMP(""SDPAT""," S ZTSAVE(X)=""
W ! D EN^XUTMDEVQ("START^SCRPW72","Clinic Appointment Availability Report",.ZTSAVE) S SDOUT=1 G EXIT^SCRPW74
;
RESEND ;Entry point for manually initiating extracts for the current month
N DIR,SDXTMP,SDMON,SDI,SDT,DTOUT,DUOUT
W !!,$C(7),"NOTE: Use of this utility will result in the transmission of extract data to"
W !,"Austin. It should only be used if automatically queued extracts failed to run."
M SDXTMP=^XTMP("SD53P192") D QDIS^SCRPW74(.SDXTMP)
F SDI=1,2 I $G(SDXTMP("EXTRACT",SDI,"DATE"))<DT D Q:$D(DTOUT)!$D(DUOUT)
.W !!,"Extract ",SDI," doesn't appear to be tasked to run repetitively in the future."
.S DIR(0)="Y",DIR("A")="Do you wish to schedule it now",DIR("B")="YES"
.W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT) D:Y RQUE(SDI)
Q:$D(DTOUT)!$D(DUOUT)
S DIR(0)="Y",DIR("B")="NO"
F SDI=1,2 D Q:$D(DTOUT)!$D(DUOUT)
.S SDT=DT S:SDI=1 SDT=$S($E(SDT,4,5)="01":$E(SDT,1,3)-1_12_$E(SDT,6,7),1:$E(SDT,1,5)-1_$E(SDT,6,7))
.S DIR("A")="Do you want transmit Extract "_SDI_" for "_$P($$MON^SCRPW74(SDI,SDT,.SDMON),U)_" to Austin"
.W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT) D:Y QUEUE(.SDMON)
Q
REQUE ;Entry point for initiating repetitive tasking of extracts
N DIR,SDXTMP,DTOUT,DUOUT
M SDXTMP=^XTMP("SD53P192") D QDIS^SCRPW74(.SDXTMP)
I '$D(SDXTMP) D W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT) I Y D RQUE("B") Q
.S DIR(0)="Y",DIR("A")="Do you want to schedule both extracts now"
.S DIR("B")="YES"
Q:$D(DTOUT)!$D(DUOUT) K DIR
S DIR(0)="S^1:EXTRACT 1 (PROSPECTIVE);2:EXTRACT 2 (RETROSPECTIVE);B:BOTH EXTRACTS"
S DIR("?",1)="Extract 1 returns future clinic availability, extract 2 returns previous",DIR("?")="clinic availability and utilization."
S DIR("A")="Specify which extract you wish to schedule"
W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT) D RQUE(Y)
Q
RQUE(SDEX) ;Schedule extract for repetitive run
;Input: SDEX=extract type, '1', '2' or 'B' for both
I SDEX="B" D RQUE(1) Q:$D(DTOUT)!$D(DUOUT) D RQUE(2) Q
N SDMON,SDNOW,SDOUT,DIR,Y,SDT
S SDNOW=$$NOW^XLFDT(),SDOUT=0,Y=$G(SDXTMP("EXTRACT",SDEX,"DATE"))
I Y>SDNOW D Q:$D(DTOUT)!$D(DUOUT) Q:SDOUT
.W !!,"Extract ",SDEX," appears to be queued for the future--"
.X ^DD("DD") W !!,"Scheduled for: ",Y,", task number: ",$G(SDXTMP("EXTRACT",SDEX,"TASK"))
.S DIR(0)="Y",DIR("B")="NO"
.S DIR("A")="Do you want to delete this task and re-schedule extract "_SDEX
.W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT) S SDOUT='Y
.Q:'Y S ZTSK=$G(SDXTMP("EXTRACT",SDEX,"TASK")) D KILL^%ZTLOAD
.K ^XTMP("SD53P192","EXTRACT",SDEX) Q
S SDT=$$WHEN^SCRPW74(SDEX),SDRPT=$$MON^SCRPW74(SDEX,SDT,.SDMON)
D SCHED^SCRPW74(SDEX,SDT,SDRPT,.SDMON) Q
QUEUE(SDMON) ;Queue extraction for re-run
;Input: SDMON=array of input parameters (as described in MON^SCRPW74)
N %DT,SDI,Y,ZTSK,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE
S Y=DT_.22 X ^DD("DD") S %DT("B")=Y,%DT("A")="Queue to run: "
S %DT="AEFXR" W ! D ^%DT I Y<1 G QQ
S ZTDTH=Y,ZTSAVE("SDMON(")="",ZTRTN="RUN^SCRPW74(0)",ZTIO=""
S ZTDESC="Clinic Appointment Wait Time Extract ("_SDMON("SDEX")_")"
F SDI=1:1:20 D ^%ZTLOAD Q:$G(ZTSK)
QQ I '$G(ZTSK) W !!,"Extract not queued!!!",! Q
W !!,"Task number: ",ZTSK,! Q
TXXM ;Transmit extract data
N SDFAC,SDL,SDIV,SDCP,SC,SDI,SDX,SDEX,SDY,SDZ,SDP,SDSIZE,SDMG,SDMGM
S SDFAC=$P($$SITE^VASITE(),U,3),SDXM=1,SDL=0,SDIV="",SDSIZE=0
S SDEX=$S(SDPAST:2,1:1)
S SDMG=$P($G(^SD(404.91,1,"PATCH192")),U,(6+SDEX))
S:SDMG="" SDMG="G.SC CLINIC WAIT TIME"
;Set up monitoring mail group
S SDMGM="SC CWT EXTRACT MONITOR"
S:'$$GOTLOCAL^XMXAPIG(SDMGM) SDMGM=""
F S SDIV=$O(^TMP("SD",$J,SDIV)) Q:SDIV="" S SDCP=0 D
.F S SDCP=$O(^TMP("SD",$J,SDIV,SDCP)) Q:'SDCP S SC=0 D
..F S SC=$O(^TMP("SD",$J,SDIV,SDCP,SC)) Q:'SC D
...I SDSIZE>29000 D EXXM(SDMG,SDMGM) ;Transmit message if >29K
...;Build record leader string
...;Reporting facility, extract date, extract type
...S SDX="#"_SDFAC_U_SDEXDT_U_SDEX
...;Format version--NOTE: THIS NUMBER MUST INCREMENTED IF THE EXTRACT
...;FORMAT IS MODIFIED (e.g. existing number + 1). Refer to patch
...;SD*5.3*249 documentation for additional information.
...S SDX=SDX_"~5"
...;Report begin date, division, credit pair
...S SDX=SDX_U_SDBDT_U_$P(SDIV,U,2)_U_SDCP_U
...;Clinic ifn and name
...S SDX=SDX_SC_"~"_$$CNAME^SCRPW72(SC)_"~"
...;Maximum days for future booking
...S SDX=SDX_+$P($G(^SC(SC,"SDP")),U,2)_U
...;Build clinic statistics string
...S SDI="" F S SDI=$O(^TMP("SD",$J,SDIV,SDCP,SC,SDI)) Q:SDI="" D
....S SDY=^TMP("SD",$J,SDIV,SDCP,SC,SDI) Q:'$L(SDY)
....F SDP=1:1 S SDZ=$P(SDY,U,SDP) Q:SDZ="" D
.....I $L(SDX)>220 D XMTX(SDX) S SDX=""
.....S SDX=SDX_$S($E(SDX,$L(SDX))=U:"",1:"|")_SDZ
...I SDEX=1 S SDX=SDX_"$" D XMTX(SDX) Q
...S SDY=$G(^TMP("SDNAVA",$J,SDIV,SDCP,SC)) ;get next ava. info.
...S SDZ=$G(^TMP("SDNAVB",$J,SDIV,SDCP,SC)) ;get additional data
...S SDY=$$NAVA(SDY) D S SDX=SDX_SDY,SDY=$$ADDL^SCRPW72(SDZ) D
....I $L(SDX)+$L(SDY)>240 D
.....S SDI=$L(SDX),SDX=SDX_$E(SDY,1,(240-SDI)),SDY=$E(SDY,(241-SDI),999)
.....D XMTX(SDX) S SDX=""
...S SDX=SDX_SDY_"$" D XMTX(SDX)
D:$D(^TMP("SDXM",$J)) EXXM(SDMG,SDMGM)
Q
EXXM(XMG,SDMGM) ;Send extract mail message
;Input: XMG=mail group to receive message
;Input: SDMGM=extract monitoring mail group (optional)
N XMSUB,XMDUZ,XMDUN,XMTEXT,XMY,XMZ
S XMSUB="Clinic Appointment Waiting Time Extract ("_SDEX_")"
S (XMDUZ,XMDUN)="Patch SD*5.3*192/Task "_$G(ZTSK)
S XMTEXT="^TMP(""SDXM"",$J,"
S XMY(XMG)="" S:$L($G(SDMGM)) XMY("G."_SDMGM)=""
D ^XMD
K ^TMP("SDXM",$J) S SDXM=1,SDSIZE=0
Q
XMTX(SDX) ;Set mail message line
;Input: SDX=text value
S ^TMP("SDXM",$J,SDXM)=SDX,SDXM=SDXM+1,SDSIZE=SDSIZE+$L(SDX)
Q
NAVA(SDY) ;Format next available appointment information
;Input: SDY=next ava. numbers from ^TMP("SDNAVA",$J,SDCP,SC)
N SDI,SDX
;Format 'next available' data
S SDX="^" F SDI=0:1:3 D
.S:SDI SDX=SDX_"|"
.S SDX=SDX_SDI_"~"_+$P(SDY,U,(SDI+SDI+1))_"~"_+$P(SDY,U,(SDI+SDI+2))
;Format 'follow up'/'non-follow up' appointment data
S SDX=SDX_U F SDI=9:2:19 D
.S:SDI>9 SDX=SDX_"|"
.S SDX=SDX_+$P(SDY,U,SDI)_"~"_+$P(SDY,U,(SDI+1))
S SDX=SDX_U_+$P(SDY,U,21)_"~"_+$P(SDY,U,22)
F SDI=23:3:35 D
.S SDX=SDX_"|"_+$P(SDY,U,SDI)_"~"_+$P(SDY,U,(SDI+1))
.S SDX=SDX_"~"_+$P(SDY,U,(SDI+2))
;Format 'appts. w/in 30 days' data
S SDX=SDX_U_+$P(SDY,U,38)_"~"_+$P(SDY,U,39)
Q SDX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPW70 9995 printed Dec 13, 2024@02:44:02 Page 2
SCRPW70 ;BP-CIOFO/KEITH,ESW - Clinic appointment availability extract ; 7/8/03 2:23pm
+1 ;;5.3;Scheduling;**192,206,223,241,249,291**;AUG 13, 1993
+2 NEW SDEX,SDDIV,DIR,SDFMT,SDFMTS,SDMAX,SDSORT,SDOUT,X,Y,DTOUT,DUOUT
+3 NEW SDREPORT,SDEDT,SDBDT,SDPEDT,SDPBDT,SDPAT,SDPT,SDJN
+4 SET SDJN=$JOB
+5 SET (SDEX,SDOUT)=0
+6 DO TITL^SCRPW50("Clinic Appointment Availability Report")
+7 IF '$$DIVA^SCRPW17(.SDDIV)
SET SDOUT=1
GOTO EXIT^SCRPW74
+8 DO SUBT^SCRPW50("**** Date Range Selection ****")
+9 WRITE !
SET %DT="AEX"
SET %DT("A")="Beginning date: "
DO ^%DT
IF Y<1
SET SDOUT=1
GOTO EXIT^SCRPW74
+10 SET SDBDT=Y
XECUTE ^DD("DD")
SET SDPBDT=Y
EDT SET %DT("A")=" Ending date: "
WRITE !
DO ^%DT
IF Y<1
SET SDOUT=1
GOTO EXIT^SCRPW74
+1 IF Y<SDBDT
WRITE !!,$CHAR(7),"End date cannot be before begin date!",!
GOTO EDT
+2 SET SDEDT=Y_.999999
XECUTE ^DD("DD")
SET SDPEDT=Y
+3 SET SDMAX=Y
DO SUBT^SCRPW50("**** Report Format Selection ***")
+4 SET DIR(0)="S^S:SUMMARY FOR DATE RANGE;D:DETAIL BY DAY"
SET DIR("A")="Select report format"
+5 WRITE !
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDOUT=1
GOTO EXIT^SCRPW74
+6 SET SDFMT=Y
if SDFMT="S"
GOTO REN
+7 ;clarification that you may skip entry for a patient
+8 WRITE !!?3,"To generate a detailed report by stop code pair or clinic,"
+9 WRITE !?3,"press 'enter' without inputting a patient name.",!
+10 SET SDPAT=0
+11 KILL ^TMP("SDPAT",SDJN)
+12 ;select patient(s)
DO SELECT^SCRPW78(SDJN,.SDPAT)
+13 SET DIR("B")="CLINIC NAME"
+14 SET DIR(0)="S^CL:CLINIC NAME;CP:CREDIT PAIR"
SET DIR("A")="Specify limiting category for detail"
+15 IF $GET(SDPAT)
SET DIR("B")="CLINIC ALL"
SET DIR(0)="S^CA:CLINIC ALL;CL:CLINIC NAME;CP:CREDIT PAIR"
+16 SET DIR("?")="Indicate if availability should be limited by clinic name or DSS credit pair."
+17 WRITE !
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDOUT=1
GOTO EXIT^SCRPW74
+18 SET SDSORT=Y
IF '$$SORT^SCRPW72(.SDSORT)
SET SDOUT=1
GOTO EXIT^SCRPW74
+19 if SDOUT
GOTO EXIT^SCRPW74
+20 IF SDBDT>DT
SET SDREPORT(1)=1
GOTO QUE
+21 GOTO RENS
REN IF SDBDT>DT
SET SDREPORT(1)=1
GOTO QUE
+1 SET DIR(0)="S^CL:ALL CLINICS;CP:CREDIT PAIR SELECTION"
SET DIR("A")="Specify if all clinics or selected clinics by credit pair"
+2 SET DIR("?")="Indicate if availability should include All clinics or clinics selected by DSS credit pair only."
+3 WRITE !
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDOUT=1
GOTO EXIT^SCRPW74
+4 SET SDFMTS=Y
IF SDFMTS="CP"
Begin DoDot:1
+5 SET SDSORT=Y
IF '$$SORT^SCRPW72(.SDSORT)
SET SDOUT=1
End DoDot:1
if SDOUT
GOTO EXIT^SCRPW74
+6 if SDOUT
GOTO EXIT^SCRPW74
RENS DO SUBT^SCRPW50("**** Report Output Section Selection ****")
ROSS SET DIR(0)="Y"
SET DIR("B")="YES"
+1 NEW II
FOR II=1:1:5
SET SDREPORT(II)=0
+2 IF '$GET(SDPAT)
Begin DoDot:1
+3 SET DIR("A")="Include 'next available' appointment statistics"
+4 WRITE !
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDOUT=1
DO EXIT^SCRPW74
QUIT
+5 SET SDREPORT(1)=Y
+6 SET DIR("A")="Include 'follow up' appointment statistics"
+7 WRITE !
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDOUT=1
DO EXIT^SCRPW74
QUIT
+8 SET SDREPORT(2)=Y
+9 SET DIR("A")="Include 'non-follow up' appointment statistics"
+10 WRITE !
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDOUT=1
DO EXIT^SCRPW74
QUIT
+11 SET SDREPORT(3)=Y
+12 IF SDFMT="D"
Begin DoDot:2
+13 SET DIR("A")="Include list of patient appointments"
+14 WRITE !
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDOUT=1
DO EXIT^SCRPW74
QUIT
+15 SET SDREPORT(4)=Y
End DoDot:2
End DoDot:1
+16 IF $GET(SDPAT)
Begin DoDot:1
+17 SET DIR("?")="Accept to print report for selected patient(s) or exit"
+18 SET DIR("A")="Print individual patient report"
Begin DoDot:2
End DoDot:2
+19 WRITE !
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDOUT=1
DO EXIT^SCRPW74
QUIT
+20 SET SDREPORT(5)=Y
End DoDot:1
+21 IF '$DATA(SDREPORT)
SET SDOUT=1
DO EXIT^SCRPW74
QUIT
+22 IF 'SDREPORT(1)
IF 'SDREPORT(2)
IF 'SDREPORT(3)
IF 'SDREPORT(4)
IF 'SDREPORT(5)
Begin DoDot:1
+23 WRITE $CHAR(7),!!,"No output elements selected--at least one must be selected to continue..."
End DoDot:1
GOTO ROSS
QUE IF SDBDT'>DT
WRITE !!,"This report requires 132 column output!"
+1 NEW ZTSAVE
FOR X="SDREPORT(","SDEX","SDBDT","SDPBDT","SDEDT","SDPEDT","SDDIV","SDDIV(","SDFMT","SDFMTS","SDSORT","SDSORT(","SDPAT","SDJN","^TMP(""SDPAT"","
SET ZTSAVE(X)=""
+2 WRITE !
DO EN^XUTMDEVQ("START^SCRPW72","Clinic Appointment Availability Report",.ZTSAVE)
SET SDOUT=1
GOTO EXIT^SCRPW74
+3 ;
RESEND ;Entry point for manually initiating extracts for the current month
+1 NEW DIR,SDXTMP,SDMON,SDI,SDT,DTOUT,DUOUT
+2 WRITE !!,$CHAR(7),"NOTE: Use of this utility will result in the transmission of extract data to"
+3 WRITE !,"Austin. It should only be used if automatically queued extracts failed to run."
+4 MERGE SDXTMP=^XTMP("SD53P192")
DO QDIS^SCRPW74(.SDXTMP)
+5 FOR SDI=1,2
IF $GET(SDXTMP("EXTRACT",SDI,"DATE"))<DT
Begin DoDot:1
+6 WRITE !!,"Extract ",SDI," doesn't appear to be tasked to run repetitively in the future."
+7 SET DIR(0)="Y"
SET DIR("A")="Do you wish to schedule it now"
SET DIR("B")="YES"
+8 WRITE !
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
if Y
DO RQUE(SDI)
End DoDot:1
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+9 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+10 SET DIR(0)="Y"
SET DIR("B")="NO"
+11 FOR SDI=1,2
Begin DoDot:1
+12 SET SDT=DT
if SDI=1
SET SDT=$SELECT($EXTRACT(SDT,4,5)="01":$EXTRACT(SDT,1,3)-1_12_$EXTRACT(SDT,6,7),1:$EXTRACT(SDT,1,5)-1_$EXTRACT(SDT,6,7))
+13 SET DIR("A")="Do you want transmit Extract "_SDI_" for "_$PIECE($$MON^SCRPW74(SDI,SDT,.SDMON),U)_" to Austin"
+14 WRITE !
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
if Y
DO QUEUE(.SDMON)
End DoDot:1
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+15 QUIT
REQUE ;Entry point for initiating repetitive tasking of extracts
+1 NEW DIR,SDXTMP,DTOUT,DUOUT
+2 MERGE SDXTMP=^XTMP("SD53P192")
DO QDIS^SCRPW74(.SDXTMP)
+3 IF '$DATA(SDXTMP)
Begin DoDot:1
+4 SET DIR(0)="Y"
SET DIR("A")="Do you want to schedule both extracts now"
+5 SET DIR("B")="YES"
End DoDot:1
WRITE !
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
IF Y
DO RQUE("B")
QUIT
+6 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
KILL DIR
+7 SET DIR(0)="S^1:EXTRACT 1 (PROSPECTIVE);2:EXTRACT 2 (RETROSPECTIVE);B:BOTH EXTRACTS"
+8 SET DIR("?",1)="Extract 1 returns future clinic availability, extract 2 returns previous"
SET DIR("?")="clinic availability and utilization."
+9 SET DIR("A")="Specify which extract you wish to schedule"
+10 WRITE !
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
DO RQUE(Y)
+11 QUIT
RQUE(SDEX) ;Schedule extract for repetitive run
+1 ;Input: SDEX=extract type, '1', '2' or 'B' for both
+2 IF SDEX="B"
DO RQUE(1)
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
DO RQUE(2)
QUIT
+3 NEW SDMON,SDNOW,SDOUT,DIR,Y,SDT
+4 SET SDNOW=$$NOW^XLFDT()
SET SDOUT=0
SET Y=$GET(SDXTMP("EXTRACT",SDEX,"DATE"))
+5 IF Y>SDNOW
Begin DoDot:1
+6 WRITE !!,"Extract ",SDEX," appears to be queued for the future--"
+7 XECUTE ^DD("DD")
WRITE !!,"Scheduled for: ",Y,", task number: ",$GET(SDXTMP("EXTRACT",SDEX,"TASK"))
+8 SET DIR(0)="Y"
SET DIR("B")="NO"
+9 SET DIR("A")="Do you want to delete this task and re-schedule extract "_SDEX
+10 WRITE !
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
SET SDOUT='Y
+11 if 'Y
QUIT
SET ZTSK=$GET(SDXTMP("EXTRACT",SDEX,"TASK"))
DO KILL^%ZTLOAD
+12 KILL ^XTMP("SD53P192","EXTRACT",SDEX)
QUIT
End DoDot:1
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
if SDOUT
QUIT
+13 SET SDT=$$WHEN^SCRPW74(SDEX)
SET SDRPT=$$MON^SCRPW74(SDEX,SDT,.SDMON)
+14 DO SCHED^SCRPW74(SDEX,SDT,SDRPT,.SDMON)
QUIT
QUEUE(SDMON) ;Queue extraction for re-run
+1 ;Input: SDMON=array of input parameters (as described in MON^SCRPW74)
+2 NEW %DT,SDI,Y,ZTSK,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE
+3 SET Y=DT_.22
XECUTE ^DD("DD")
SET %DT("B")=Y
SET %DT("A")="Queue to run: "
+4 SET %DT="AEFXR"
WRITE !
DO ^%DT
IF Y<1
GOTO QQ
+5 SET ZTDTH=Y
SET ZTSAVE("SDMON(")=""
SET ZTRTN="RUN^SCRPW74(0)"
SET ZTIO=""
+6 SET ZTDESC="Clinic Appointment Wait Time Extract ("_SDMON("SDEX")_")"
+7 FOR SDI=1:1:20
DO ^%ZTLOAD
if $GET(ZTSK)
QUIT
QQ IF '$GET(ZTSK)
WRITE !!,"Extract not queued!!!",!
QUIT
+1 WRITE !!,"Task number: ",ZTSK,!
QUIT
TXXM ;Transmit extract data
+1 NEW SDFAC,SDL,SDIV,SDCP,SC,SDI,SDX,SDEX,SDY,SDZ,SDP,SDSIZE,SDMG,SDMGM
+2 SET SDFAC=$PIECE($$SITE^VASITE(),U,3)
SET SDXM=1
SET SDL=0
SET SDIV=""
SET SDSIZE=0
+3 SET SDEX=$SELECT(SDPAST:2,1:1)
+4 SET SDMG=$PIECE($GET(^SD(404.91,1,"PATCH192")),U,(6+SDEX))
+5 if SDMG=""
SET SDMG="G.SC CLINIC WAIT TIME"
+6 ;Set up monitoring mail group
+7 SET SDMGM="SC CWT EXTRACT MONITOR"
+8 if '$$GOTLOCAL^XMXAPIG(SDMGM)
SET SDMGM=""
+9 FOR
SET SDIV=$ORDER(^TMP("SD",$JOB,SDIV))
if SDIV=""
QUIT
SET SDCP=0
Begin DoDot:1
+10 FOR
SET SDCP=$ORDER(^TMP("SD",$JOB,SDIV,SDCP))
if 'SDCP
QUIT
SET SC=0
Begin DoDot:2
+11 FOR
SET SC=$ORDER(^TMP("SD",$JOB,SDIV,SDCP,SC))
if 'SC
QUIT
Begin DoDot:3
+12 ;Transmit message if >29K
IF SDSIZE>29000
DO EXXM(SDMG,SDMGM)
+13 ;Build record leader string
+14 ;Reporting facility, extract date, extract type
+15 SET SDX="#"_SDFAC_U_SDEXDT_U_SDEX
+16 ;Format version--NOTE: THIS NUMBER MUST INCREMENTED IF THE EXTRACT
+17 ;FORMAT IS MODIFIED (e.g. existing number + 1). Refer to patch
+18 ;SD*5.3*249 documentation for additional information.
+19 SET SDX=SDX_"~5"
+20 ;Report begin date, division, credit pair
+21 SET SDX=SDX_U_SDBDT_U_$PIECE(SDIV,U,2)_U_SDCP_U
+22 ;Clinic ifn and name
+23 SET SDX=SDX_SC_"~"_$$CNAME^SCRPW72(SC)_"~"
+24 ;Maximum days for future booking
+25 SET SDX=SDX_+$PIECE($GET(^SC(SC,"SDP")),U,2)_U
+26 ;Build clinic statistics string
+27 SET SDI=""
FOR
SET SDI=$ORDER(^TMP("SD",$JOB,SDIV,SDCP,SC,SDI))
if SDI=""
QUIT
Begin DoDot:4
+28 SET SDY=^TMP("SD",$JOB,SDIV,SDCP,SC,SDI)
if '$LENGTH(SDY)
QUIT
+29 FOR SDP=1:1
SET SDZ=$PIECE(SDY,U,SDP)
if SDZ=""
QUIT
Begin DoDot:5
+30 IF $LENGTH(SDX)>220
DO XMTX(SDX)
SET SDX=""
+31 SET SDX=SDX_$SELECT($EXTRACT(SDX,$LENGTH(SDX))=U:"",1:"|")_SDZ
End DoDot:5
End DoDot:4
+32 IF SDEX=1
SET SDX=SDX_"$"
DO XMTX(SDX)
QUIT
+33 ;get next ava. info.
SET SDY=$GET(^TMP("SDNAVA",$JOB,SDIV,SDCP,SC))
+34 ;get additional data
SET SDZ=$GET(^TMP("SDNAVB",$JOB,SDIV,SDCP,SC))
+35 SET SDY=$$NAVA(SDY)
Begin DoDot:4
+36 IF $LENGTH(SDX)+$LENGTH(SDY)>240
Begin DoDot:5
+37 SET SDI=$LENGTH(SDX)
SET SDX=SDX_$EXTRACT(SDY,1,(240-SDI))
SET SDY=$EXTRACT(SDY,(241-SDI),999)
+38 DO XMTX(SDX)
SET SDX=""
End DoDot:5
End DoDot:4
SET SDX=SDX_SDY
SET SDY=$$ADDL^SCRPW72(SDZ)
Begin DoDot:4
End DoDot:4
+39 SET SDX=SDX_SDY_"$"
DO XMTX(SDX)
End DoDot:3
End DoDot:2
End DoDot:1
+40 if $DATA(^TMP("SDXM",$JOB))
DO EXXM(SDMG,SDMGM)
+41 QUIT
EXXM(XMG,SDMGM) ;Send extract mail message
+1 ;Input: XMG=mail group to receive message
+2 ;Input: SDMGM=extract monitoring mail group (optional)
+3 NEW XMSUB,XMDUZ,XMDUN,XMTEXT,XMY,XMZ
+4 SET XMSUB="Clinic Appointment Waiting Time Extract ("_SDEX_")"
+5 SET (XMDUZ,XMDUN)="Patch SD*5.3*192/Task "_$GET(ZTSK)
+6 SET XMTEXT="^TMP(""SDXM"",$J,"
+7 SET XMY(XMG)=""
if $LENGTH($GET(SDMGM))
SET XMY("G."_SDMGM)=""
+8 DO ^XMD
+9 KILL ^TMP("SDXM",$JOB)
SET SDXM=1
SET SDSIZE=0
+10 QUIT
XMTX(SDX) ;Set mail message line
+1 ;Input: SDX=text value
+2 SET ^TMP("SDXM",$JOB,SDXM)=SDX
SET SDXM=SDXM+1
SET SDSIZE=SDSIZE+$LENGTH(SDX)
+3 QUIT
NAVA(SDY) ;Format next available appointment information
+1 ;Input: SDY=next ava. numbers from ^TMP("SDNAVA",$J,SDCP,SC)
+2 NEW SDI,SDX
+3 ;Format 'next available' data
+4 SET SDX="^"
FOR SDI=0:1:3
Begin DoDot:1
+5 if SDI
SET SDX=SDX_"|"
+6 SET SDX=SDX_SDI_"~"_+$PIECE(SDY,U,(SDI+SDI+1))_"~"_+$PIECE(SDY,U,(SDI+SDI+2))
End DoDot:1
+7 ;Format 'follow up'/'non-follow up' appointment data
+8 SET SDX=SDX_U
FOR SDI=9:2:19
Begin DoDot:1
+9 if SDI>9
SET SDX=SDX_"|"
+10 SET SDX=SDX_+$PIECE(SDY,U,SDI)_"~"_+$PIECE(SDY,U,(SDI+1))
End DoDot:1
+11 SET SDX=SDX_U_+$PIECE(SDY,U,21)_"~"_+$PIECE(SDY,U,22)
+12 FOR SDI=23:3:35
Begin DoDot:1
+13 SET SDX=SDX_"|"_+$PIECE(SDY,U,SDI)_"~"_+$PIECE(SDY,U,(SDI+1))
+14 SET SDX=SDX_"~"_+$PIECE(SDY,U,(SDI+2))
End DoDot:1
+15 ;Format 'appts. w/in 30 days' data
+16 SET SDX=SDX_U_+$PIECE(SDY,U,38)_"~"_+$PIECE(SDY,U,39)
+17 QUIT SDX
