- SCRPW70 ;BP-CIOFO/KEITH,ESW - Clinic appointment availability extract ; 7/8/03 2:23pm
- ;;5.3;Scheduling;**192,206,223,241,249,291,1015**;AUG 13, 1993;Build 21
- 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
- SCRPW70 ;BP-CIOFO/KEITH,ESW - Clinic appointment availability extract ; 7/8/03 2:23pm
- +1 ;;5.3;Scheduling;**192,206,223,241,249,291,1015**;AUG 13, 1993;Build 21
- +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
