BSDCCR4 ; IHS/ANMC/LJF - CLINIC CAPACITY REPORT CONT. ;
;;5.3;PIMS;;APR 26, 2002
;COPY OF SCRPW74 BEFORE PATCH #223
;IHS/ANMC/LJF 10/06/2000 removed quit in EXIT subroutine
; & removed call to END^SCRPW50 which can added to option exit action
;
MON(SDEX,SDT,SDMON) ;Determine month and date ranges for extracts
;Input: SDEX=extract type, '1' for prospective, '2' for retrospective
;Input: SDT=date of extract run
;Input: SDMON=array to return date information (pass by reference)
;Output: month/year of extract^begin date of report data
;Output: SDMON array as follows:
; SDMON("SDBDT")=begin date
; SDMON("SDDIV")=0
; SDMON("SDEDT")=end date
; SDMON("SDEX")=extract type ('1' or '2')
; SDMON("SDPAST")='1' for extract 2, '0' otherwise
; SDMON("SDPBDT")=begin date external value
; SDMON("SDPEDT")=end date external value
; SDMON("SDRPT")=month/year of extract^begin date of data
;
N SDPAR,Y,SDX,SDY,X1,X2
S SDMON("SDDIV")=0,SDMON("SDPAST")=$S(SDEX=1:0,1:1)
S SDMON("SDEX")=SDEX,SDPAR=$G(^SD(404.91,1,"PATCH192"))
I SDEX=1 D
.S Y=$S($E(SDT,4,5)=12:$E(SDT,1,3)+1_"0101",1:$E(SDT,1,5)+1_"01")
.S SDMON("SDBDT")=Y X ^DD("DD") S SDMON("SDPBDT")=Y
.S X1=SDMON("SDBDT"),X2=$P(SDPAR,U,2) S:X2<1 X2=180 S X2=X2-1
.D C^%DTC S (SDMON("SDEDT"),Y)=X X ^DD("DD") S SDMON("SDPEDT")=Y
.Q
I SDEX=2 D
.S Y=$S($E(SDT,4,5)="01":$E(SDT,1,3)-1_1201,1:$E(SDT,1,5)-1_"01")
.S SDMON("SDBDT")=Y X ^DD("DD") S SDMON("SDPBDT")=Y
.S X1=SDMON("SDBDT"),X2=$P(SDPAR,U,4) S:X2<1 X2=31 S X2=X2-1
.D C^%DTC I $E(X,1,5)>$E(SDMON("SDBDT"),1,5) D
..S X1=$E(X,1,5)_"01",X2=-1 D C^%DTC Q
.S (SDMON("SDEDT"),Y)=X X ^DD("DD") S SDMON("SDPEDT")=Y
.Q
S SDY=SDMON("SDBDT")
S:SDEX=2 SDY=$S($E(SDY,4,5)=12:$E(SDY,1,3)+1_"0101",1:$E(SDY,1,5)+1_"01") S SDX=+$E(SDY,4,5)
S SDX=$P("JANUARY^FEBRUARY^MARCH^APRIL^MAY^JUNE^JULY^AUGUST^SEPTEMBER^OCTOBER^NOVEMBER^DECEMBER",U,SDX)
S SDX=SDX_" "_(17+$E(SDY)_$E(SDY,2,3))_U_SDMON("SDBDT")
S SDMON("SDRPT")=SDX
Q SDX
;
QDIS(SDXTMP) ;Display extract queuing information
;Input: SDXTMP=array of data from ^XTMP("SD53P192")
N SDEX,Y
W !!?18,"*** Extract queuing information on file ***"
I '$D(SDXTMP) W !!,"==> No extract queuing data found" Q
F SDEX=1,2 D
.W !!?22,"Extract ",SDEX," report: ",$P($G(SDXTMP("EXTRACT",SDEX,"REPORT")),U)
.W !?24,"Extract 1 task: ",$G(SDXTMP("EXTRACT",SDEX,"TASK"))
.S Y=$G(SDXTMP("EXTRACT",SDEX,"DATE")) I Y X ^DD("DD")
.W !?20,"Extract ",SDEX," run date: ",Y
.Q
Q
;
DAYS(SDATE,SDAY) ;Adjust target day if necessary
;Input: SDATE=date
;Input: SDAY=target day
;Output: target SDAY for the month of SDATE, adjusted if necessary
N SDX,X,X1,X2
S X1=$S($E(SDATE,4,5)=12:($E(SDATE,1,3)+1)_"01",1:$E(SDATE,1,5)+1)_"01"
S X2=-1 D C^%DTC S SDX=$E(X,6,7)
Q $S(SDX<SDAY:SDX,1:SDAY)
;
WHEN(SDEX,SDNOW) ;Determine date for next run
;Input: SDEX=extract type
;Input: SDDT=date/time to calculate from (optional)
;Output: if success, date/time for next run
; if already scheduled, -1^date_scheduled^task_number
N SDPAR,SDAY,X1,X2,X,SDTIME,SDINT,SDT,SDDT
S SDNOW=$G(SDNOW) I SDNOW<1 S SDNOW=$$NOW^XLFDT()
S SDDT=$P(SDNOW,".")
;
;Quit if already scheduled
Q:$G(^XTMP("SD53P192","EXTRACT",SDEX,"DATE"))>SDNOW "-1^"_^XTMP("SD53P192","EXTRACT",SDEX,"DATE")_U_$G(^XTMP("SD53P192","EXTRACT",SDEX,"TASK"))
;
S SDPAR=$G(^SD(404.91,1,"PATCH192")),SDAY=$P(SDPAR,U) S:'SDAY SDAY=31
S SDINT=$P(SDPAR,U,5) I SDINT=""!("MQSA"'[SDINT) S SDINT="M"
S SDTIME=$P(SDPAR,U,6) I 'SDTIME!(SDTIME>.2359) S SDTIME=.22
S X1=$E(SDDT,1,5)_"01",X2=$$DAYS(SDDT,SDAY)-1 D C^%DTC
I (X+SDTIME)<SDNOW D
.S X1=$S($E(X,4,5)=12:($E(X,1,3)+1)_"01",1:$E(X,1,5)+1)_"01"
.S X2=$$DAYS(X1,SDAY)-1 D C^%DTC
.Q
;
;Values for monthly queuing
I SDINT="M" Q:SDEX=1 X+SDTIME Q $$WHEN2(X)
;
;Values for quarterly queuing
I SDINT="Q" D Q X
.S X1=+$E(X,4,5),X1=$S(X1<4:"03",X1<7:"06",X1<10:"09",1:12)
.S X1=$E(X,1,3)_X1_"01",X2=$$DAYS(X1,SDAY)-1 D C^%DTC
.I SDEX=1 S X=X+SDTIME Q
.S X=$$WHEN2(X) Q
;
;Values for semi-annual queuing
I SDINT="S" D Q X
.S X1=+$E(X,4,5) S:X1>9 X=$E(X,1,3)+1_$E(X,4,7)
.S X1=$S(X1<4:"03",X1<10:"09",1:"03")
.S X1=$E(X,1,3)_X1_"01",X2=$$DAYS(X1,SDAY)-1 D C^%DTC
.I SDEX=1 S X=X+SDTIME Q
.S X=$$WHEN2(X) Q
;
;Values for annual queuing
S X1=+$E(X,4,5) S:X1>9 X=$E(X,1,3)+1_$E(X,4,7)
S X=$E(X,1,3)_"0901",X2=$$DAYS(X1,SDAY)-1 D C^%DTC
Q:SDEX=1 X+SDTIME Q $$WHEN2(X)
;
WHEN2(X) ;Determine date for extract 2
;Input: X=date for extract 1
;Output: date/time for extract 2
S SDT=$S($E(X,4,5)=12:$E(X,1,3)+1_"0101",1:$E(X,1,5)+1_"01")
S SDAY=$P(SDPAR,U,3) S:'SDAY!SDAY>31 SDAY=5
S X1=SDT,X2=$$DAYS(SDT,SDAY)-1 D C^%DTC
S X=X+SDTIME Q X
;
SCHED(SDEX,SDT,SDRPT,SDMON,SDKID) ;Schedule repetitive extract run
;Input: SDEX=extract type
;Input: SDT=date/time to queue extract
;Input: SDRPT=month/year of report^begin date of report data
;Input: SDMON=report parameters from MON^BSDCCR4 (pass by reference)
;Input: SDKID='1' if from KIDS install (optional)
N SDI,Y,ZTSK,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE
S ZTDTH=SDT,ZTSAVE("SDMON(")="",ZTRTN="RUN^BSDCCR4(1)",ZTIO=""
S ZTDESC="Clinic Appointment Wait Time Extract ("_SDMON("SDEX")_")"
F SDI=1:1:20 D ^%ZTLOAD Q:$G(ZTSK)
;
QQ I '$G(ZTSK) D Q
.I $G(SDKID) D BMES^XPDUTL("Extract not queued!!!") Q
.W !!,"Extract not queued!!!",! Q
S Y=SDT X ^DD("DD")
I $G(SDKID) D BMES^XPDUTL("Extract "_SDEX_" queued for "_Y_", task number: "_ZTSK)
I '$G(SDKID) W !!,"Extract "_SDEX_" queued for "_Y_", task number: "_ZTSK,!
;
XTMP ;Service ^XTMP nodes
N X1,X2,X
S X1=$P($P(SDT,U),"."),X2=45 D C^%DTC S SDPGDT=X
I '$D(^XTMP("SD53P192",0)) D
.S ^XTMP("SD53P192",0)=SDPGDT_"^Patch SD*5.3*192 'Clinic Wait Time' extract repetitive queuing information. Created by user: "_DUZ
.Q
S:$P(^XTMP("SD53P192",0),U)<SDPGDT $P(^XTMP("SD53P192",0),U)=SDPGDT
S ^XTMP("SD53P192","EXTRACT",SDEX,"TASK")=ZTSK
S ^XTMP("SD53P192","EXTRACT",SDEX,"DATE")=SDT
S ^XTMP("SD53P192","EXTRACT",SDEX,"REPORT")=SDRPT
Q
;
RUN(SDR) ;Run extract (reschedule if requested)
;Input: SDR='1' if rescheduling is requested, '0' otherwise.
N SDV,SDBDT,SDDIV,SDEDT,SDEX,SDPAST,SDPBDT,SDPEDT,SDRPT
S SDV="" F S SDV=$O(SDMON(SDV)) Q:SDV="" S @SDV=SDMON(SDV)
I SDR=1 D
.I $G(^XTMP("SD53P192","EXTRACT",SDEX,"TASK"))=ZTSK K ^XTMP("SD53P192","EXTRACT",SDEX)
.N SDT,SDMON
.S SDT=$P(SDRPT,U,2)
.S:SDEX=2 SDT=$S($E(SDT,4,5)=12:$E(SDT,1,3)+1_"0101",1:$E(SDT,1,5)+1_"01")
.S SDT=$$WHEN(SDEX),SDRPT=$$MON(SDEX,SDT,.SDMON)
.D SCHED(SDEX,SDT,SDRPT,.SDMON)
.Q
D EXTRACT^BSDCCR2
;
EXIT ;Q ;I $E(IOST)="C",'$G(SDOUT),'$G(SDXM) N DIR S DIR(0)="E" D ^DIR ;IHS/ANMC/LJF 10/6/2000
F SDI="SD","SDS","SDTMP","SDTOT","SDXM","SDNAVA" K ^TMP(SDI,$J)
K %,%DT,%H,%I,%T,%Y,CT,D,DA,DAY,DIC,DIE,DIR,DR,DTOUT,DUOUT,ENDATE
K I,J,MAX,MAXDT,SC,SC0,SCNA,SD,SDAY,SDBDT,SDBEG,SDC
K SDCAP,SDCCP,SDCNAM,SDCOL,SDCP,SDCT,SDDAY,SDDIV,SDDT,SDDV,SDDW
K SDEDT,SDEND,SDEX,SDEXDT,SDFAC,SDFMT,SDHD,SDI,SDIN,SDINT,SDIV
K SDKID,SDL,SDLINE,SDMAX,SDMD,SDMG,SDMON,SDMPDT,SDNOW,SDOE,SDOE0
K SDOUT,SDP,SDPAGE,SDPAR,SDPAST,SDPATT,SDPBDT,SDPCT,SDPEDT,SDPG
K SDPGDT,SDPNOW,SDQUIT,SDR,SDRE,SDRPT,SDS,SDSC1,SDSC2,SDSIZE,SDSL
K SDSOH,SDSORT,SDSSC,SDSTRTDT,SDT,SDTCAP,SDTIME,SDTIT,SDTITL,SDTOE
K SDTSL,SDTX,SDTY,SDV,SDX,SDXM,SDXTMP,SDY,SDZ,SI,SM,SS,X,X1,X2,Y
;D:$D(IOM) END^SCRPW50 Q ;IHS/ANMC/LJF 10/6/2000
BSDCCR4 ; IHS/ANMC/LJF - CLINIC CAPACITY REPORT CONT. ;
+1 ;;5.3;PIMS;;APR 26, 2002
+2 ;COPY OF SCRPW74 BEFORE PATCH #223
+3 ;IHS/ANMC/LJF 10/06/2000 removed quit in EXIT subroutine
+4 ; & removed call to END^SCRPW50 which can added to option exit action
+5 ;
MON(SDEX,SDT,SDMON) ;Determine month and date ranges for extracts
+1 ;Input: SDEX=extract type, '1' for prospective, '2' for retrospective
+2 ;Input: SDT=date of extract run
+3 ;Input: SDMON=array to return date information (pass by reference)
+4 ;Output: month/year of extract^begin date of report data
+5 ;Output: SDMON array as follows:
+6 ; SDMON("SDBDT")=begin date
+7 ; SDMON("SDDIV")=0
+8 ; SDMON("SDEDT")=end date
+9 ; SDMON("SDEX")=extract type ('1' or '2')
+10 ; SDMON("SDPAST")='1' for extract 2, '0' otherwise
+11 ; SDMON("SDPBDT")=begin date external value
+12 ; SDMON("SDPEDT")=end date external value
+13 ; SDMON("SDRPT")=month/year of extract^begin date of data
+14 ;
+15 NEW SDPAR,Y,SDX,SDY,X1,X2
+16 SET SDMON("SDDIV")=0
SET SDMON("SDPAST")=$SELECT(SDEX=1:0,1:1)
+17 SET SDMON("SDEX")=SDEX
SET SDPAR=$GET(^SD(404.91,1,"PATCH192"))
+18 IF SDEX=1
Begin DoDot:1
+19 SET Y=$SELECT($EXTRACT(SDT,4,5)=12:$EXTRACT(SDT,1,3)+1_"0101",1:$EXTRACT(SDT,1,5)+1_"01")
+20 SET SDMON("SDBDT")=Y
XECUTE ^DD("DD")
SET SDMON("SDPBDT")=Y
+21 SET X1=SDMON("SDBDT")
SET X2=$PIECE(SDPAR,U,2)
IF X2<1
SET X2=180
SET X2=X2-1
+22 DO C^%DTC
SET (SDMON("SDEDT"),Y)=X
XECUTE ^DD("DD")
SET SDMON("SDPEDT")=Y
+23 QUIT
End DoDot:1
+24 IF SDEX=2
Begin DoDot:1
+25 SET Y=$SELECT($EXTRACT(SDT,4,5)="01":$EXTRACT(SDT,1,3)-1_1201,1:$EXTRACT(SDT,1,5)-1_"01")
+26 SET SDMON("SDBDT")=Y
XECUTE ^DD("DD")
SET SDMON("SDPBDT")=Y
+27 SET X1=SDMON("SDBDT")
SET X2=$PIECE(SDPAR,U,4)
IF X2<1
SET X2=31
SET X2=X2-1
+28 DO C^%DTC
IF $EXTRACT(X,1,5)>$EXTRACT(SDMON("SDBDT"),1,5)
Begin DoDot:2
+29 SET X1=$EXTRACT(X,1,5)_"01"
SET X2=-1
DO C^%DTC
QUIT
End DoDot:2
+30 SET (SDMON("SDEDT"),Y)=X
XECUTE ^DD("DD")
SET SDMON("SDPEDT")=Y
+31 QUIT
End DoDot:1
+32 SET SDY=SDMON("SDBDT")
+33 IF SDEX=2
SET SDY=$SELECT($EXTRACT(SDY,4,5)=12:$EXTRACT(SDY,1,3)+1_"0101",1:$EXTRACT(SDY,1,5)+1_"01")
SET SDX=+$EXTRACT(SDY,4,5)
+34 SET SDX=$PIECE("JANUARY^FEBRUARY^MARCH^APRIL^MAY^JUNE^JULY^AUGUST^SEPTEMBER^OCTOBER^NOVEMBER^DECEMBER",U,SDX)
+35 SET SDX=SDX_" "_(17+$EXTRACT(SDY)_$EXTRACT(SDY,2,3))_U_SDMON("SDBDT")
+36 SET SDMON("SDRPT")=SDX
+37 QUIT SDX
+38 ;
QDIS(SDXTMP) ;Display extract queuing information
+1 ;Input: SDXTMP=array of data from ^XTMP("SD53P192")
+2 NEW SDEX,Y
+3 WRITE !!?18,"*** Extract queuing information on file ***"
+4 IF '$DATA(SDXTMP)
WRITE !!,"==> No extract queuing data found"
QUIT
+5 FOR SDEX=1,2
Begin DoDot:1
+6 WRITE !!?22,"Extract ",SDEX," report: ",$PIECE($GET(SDXTMP("EXTRACT",SDEX,"REPORT")),U)
+7 WRITE !?24,"Extract 1 task: ",$GET(SDXTMP("EXTRACT",SDEX,"TASK"))
+8 SET Y=$GET(SDXTMP("EXTRACT",SDEX,"DATE"))
IF Y
XECUTE ^DD("DD")
+9 WRITE !?20,"Extract ",SDEX," run date: ",Y
+10 QUIT
End DoDot:1
+11 QUIT
+12 ;
DAYS(SDATE,SDAY) ;Adjust target day if necessary
+1 ;Input: SDATE=date
+2 ;Input: SDAY=target day
+3 ;Output: target SDAY for the month of SDATE, adjusted if necessary
+4 NEW SDX,X,X1,X2
+5 SET X1=$SELECT($EXTRACT(SDATE,4,5)=12:($EXTRACT(SDATE,1,3)+1)_"01",1:$EXTRACT(SDATE,1,5)+1)_"01"
+6 SET X2=-1
DO C^%DTC
SET SDX=$EXTRACT(X,6,7)
+7 QUIT $SELECT(SDX<SDAY:SDX,1:SDAY)
+8 ;
WHEN(SDEX,SDNOW) ;Determine date for next run
+1 ;Input: SDEX=extract type
+2 ;Input: SDDT=date/time to calculate from (optional)
+3 ;Output: if success, date/time for next run
+4 ; if already scheduled, -1^date_scheduled^task_number
+5 NEW SDPAR,SDAY,X1,X2,X,SDTIME,SDINT,SDT,SDDT
+6 SET SDNOW=$GET(SDNOW)
IF SDNOW<1
SET SDNOW=$$NOW^XLFDT()
+7 SET SDDT=$PIECE(SDNOW,".")
+8 ;
+9 ;Quit if already scheduled
+10 IF $GET(^XTMP("SD53P192","EXTRACT",SDEX,"DATE"))>SDNOW
QUIT "-1^"_^XTMP("SD53P192","EXTRACT",SDEX,"DATE")_U_$GET(^XTMP("SD53P192","EXTRACT",SDEX,"TASK"))
+11 ;
+12 SET SDPAR=$GET(^SD(404.91,1,"PATCH192"))
SET SDAY=$PIECE(SDPAR,U)
IF 'SDAY
SET SDAY=31
+13 SET SDINT=$PIECE(SDPAR,U,5)
IF SDINT=""!("MQSA"'[SDINT)
SET SDINT="M"
+14 SET SDTIME=$PIECE(SDPAR,U,6)
IF 'SDTIME!(SDTIME>.2359)
SET SDTIME=.22
+15 SET X1=$EXTRACT(SDDT,1,5)_"01"
SET X2=$$DAYS(SDDT,SDAY)-1
DO C^%DTC
+16 IF (X+SDTIME)<SDNOW
Begin DoDot:1
+17 SET X1=$SELECT($EXTRACT(X,4,5)=12:($EXTRACT(X,1,3)+1)_"01",1:$EXTRACT(X,1,5)+1)_"01"
+18 SET X2=$$DAYS(X1,SDAY)-1
DO C^%DTC
+19 QUIT
End DoDot:1
+20 ;
+21 ;Values for monthly queuing
+22 IF SDINT="M"
IF SDEX=1
QUIT X+SDTIME
QUIT $$WHEN2(X)
+23 ;
+24 ;Values for quarterly queuing
+25 IF SDINT="Q"
Begin DoDot:1
+26 SET X1=+$EXTRACT(X,4,5)
SET X1=$SELECT(X1<4:"03",X1<7:"06",X1<10:"09",1:12)
+27 SET X1=$EXTRACT(X,1,3)_X1_"01"
SET X2=$$DAYS(X1,SDAY)-1
DO C^%DTC
+28 IF SDEX=1
SET X=X+SDTIME
QUIT
+29 SET X=$$WHEN2(X)
QUIT
End DoDot:1
QUIT X
+30 ;
+31 ;Values for semi-annual queuing
+32 IF SDINT="S"
Begin DoDot:1
+33 SET X1=+$EXTRACT(X,4,5)
IF X1>9
SET X=$EXTRACT(X,1,3)+1_$EXTRACT(X,4,7)
+34 SET X1=$SELECT(X1<4:"03",X1<10:"09",1:"03")
+35 SET X1=$EXTRACT(X,1,3)_X1_"01"
SET X2=$$DAYS(X1,SDAY)-1
DO C^%DTC
+36 IF SDEX=1
SET X=X+SDTIME
QUIT
+37 SET X=$$WHEN2(X)
QUIT
End DoDot:1
QUIT X
+38 ;
+39 ;Values for annual queuing
+40 SET X1=+$EXTRACT(X,4,5)
IF X1>9
SET X=$EXTRACT(X,1,3)+1_$EXTRACT(X,4,7)
+41 SET X=$EXTRACT(X,1,3)_"0901"
SET X2=$$DAYS(X1,SDAY)-1
DO C^%DTC
+42 IF SDEX=1
QUIT X+SDTIME
QUIT $$WHEN2(X)
+43 ;
WHEN2(X) ;Determine date for extract 2
+1 ;Input: X=date for extract 1
+2 ;Output: date/time for extract 2
+3 SET SDT=$SELECT($EXTRACT(X,4,5)=12:$EXTRACT(X,1,3)+1_"0101",1:$EXTRACT(X,1,5)+1_"01")
+4 SET SDAY=$PIECE(SDPAR,U,3)
IF 'SDAY!SDAY>31
SET SDAY=5
+5 SET X1=SDT
SET X2=$$DAYS(SDT,SDAY)-1
DO C^%DTC
+6 SET X=X+SDTIME
QUIT X
+7 ;
SCHED(SDEX,SDT,SDRPT,SDMON,SDKID) ;Schedule repetitive extract run
+1 ;Input: SDEX=extract type
+2 ;Input: SDT=date/time to queue extract
+3 ;Input: SDRPT=month/year of report^begin date of report data
+4 ;Input: SDMON=report parameters from MON^BSDCCR4 (pass by reference)
+5 ;Input: SDKID='1' if from KIDS install (optional)
+6 NEW SDI,Y,ZTSK,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE
+7 SET ZTDTH=SDT
SET ZTSAVE("SDMON(")=""
SET ZTRTN="RUN^BSDCCR4(1)"
SET ZTIO=""
+8 SET ZTDESC="Clinic Appointment Wait Time Extract ("_SDMON("SDEX")_")"
+9 FOR SDI=1:1:20
DO ^%ZTLOAD
IF $GET(ZTSK)
QUIT
+10 ;
QQ IF '$GET(ZTSK)
Begin DoDot:1
+1 IF $GET(SDKID)
DO BMES^XPDUTL("Extract not queued!!!")
QUIT
+2 WRITE !!,"Extract not queued!!!",!
QUIT
End DoDot:1
QUIT
+3 SET Y=SDT
XECUTE ^DD("DD")
+4 IF $GET(SDKID)
DO BMES^XPDUTL("Extract "_SDEX_" queued for "_Y_", task number: "_ZTSK)
+5 IF '$GET(SDKID)
WRITE !!,"Extract "_SDEX_" queued for "_Y_", task number: "_ZTSK,!
+6 ;
XTMP ;Service ^XTMP nodes
+1 NEW X1,X2,X
+2 SET X1=$PIECE($PIECE(SDT,U),".")
SET X2=45
DO C^%DTC
SET SDPGDT=X
+3 IF '$DATA(^XTMP("SD53P192",0))
Begin DoDot:1
+4 SET ^XTMP("SD53P192",0)=SDPGDT_"^Patch SD*5.3*192 'Clinic Wait Time' extract repetitive queuing information. Created by user: "_DUZ
+5 QUIT
End DoDot:1
+6 IF $PIECE(^XTMP("SD53P192",0),U)<SDPGDT
SET $PIECE(^XTMP("SD53P192",0),U)=SDPGDT
+7 SET ^XTMP("SD53P192","EXTRACT",SDEX,"TASK")=ZTSK
+8 SET ^XTMP("SD53P192","EXTRACT",SDEX,"DATE")=SDT
+9 SET ^XTMP("SD53P192","EXTRACT",SDEX,"REPORT")=SDRPT
+10 QUIT
+11 ;
RUN(SDR) ;Run extract (reschedule if requested)
+1 ;Input: SDR='1' if rescheduling is requested, '0' otherwise.
+2 NEW SDV,SDBDT,SDDIV,SDEDT,SDEX,SDPAST,SDPBDT,SDPEDT,SDRPT
+3 SET SDV=""
FOR
SET SDV=$ORDER(SDMON(SDV))
IF SDV=""
QUIT
SET @SDV=SDMON(SDV)
+4 IF SDR=1
Begin DoDot:1
+5 IF $GET(^XTMP("SD53P192","EXTRACT",SDEX,"TASK"))=ZTSK
KILL ^XTMP("SD53P192","EXTRACT",SDEX)
+6 NEW SDT,SDMON
+7 SET SDT=$PIECE(SDRPT,U,2)
+8 IF SDEX=2
SET SDT=$SELECT($EXTRACT(SDT,4,5)=12:$EXTRACT(SDT,1,3)+1_"0101",1:$EXTRACT(SDT,1,5)+1_"01")
+9 SET SDT=$$WHEN(SDEX)
SET SDRPT=$$MON(SDEX,SDT,.SDMON)
+10 DO SCHED(SDEX,SDT,SDRPT,.SDMON)
+11 QUIT
End DoDot:1
+12 DO EXTRACT^BSDCCR2
+13 ;
EXIT ;Q ;I $E(IOST)="C",'$G(SDOUT),'$G(SDXM) N DIR S DIR(0)="E" D ^DIR ;IHS/ANMC/LJF 10/6/2000
+1 FOR SDI="SD","SDS","SDTMP","SDTOT","SDXM","SDNAVA"
KILL ^TMP(SDI,$JOB)
+2 KILL %,%DT,%H,%I,%T,%Y,CT,D,DA,DAY,DIC,DIE,DIR,DR,DTOUT,DUOUT,ENDATE
+3 KILL I,J,MAX,MAXDT,SC,SC0,SCNA,SD,SDAY,SDBDT,SDBEG,SDC
+4 KILL SDCAP,SDCCP,SDCNAM,SDCOL,SDCP,SDCT,SDDAY,SDDIV,SDDT,SDDV,SDDW
+5 KILL SDEDT,SDEND,SDEX,SDEXDT,SDFAC,SDFMT,SDHD,SDI,SDIN,SDINT,SDIV
+6 KILL SDKID,SDL,SDLINE,SDMAX,SDMD,SDMG,SDMON,SDMPDT,SDNOW,SDOE,SDOE0
+7 KILL SDOUT,SDP,SDPAGE,SDPAR,SDPAST,SDPATT,SDPBDT,SDPCT,SDPEDT,SDPG
+8 KILL SDPGDT,SDPNOW,SDQUIT,SDR,SDRE,SDRPT,SDS,SDSC1,SDSC2,SDSIZE,SDSL
+9 KILL SDSOH,SDSORT,SDSSC,SDSTRTDT,SDT,SDTCAP,SDTIME,SDTIT,SDTITL,SDTOE
+10 KILL SDTSL,SDTX,SDTY,SDV,SDX,SDXM,SDXTMP,SDY,SDZ,SI,SM,SS,X,X1,X2,Y
+11 ;D:$D(IOM) END^SCRPW50 Q ;IHS/ANMC/LJF 10/6/2000
