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

BSDCCR4.m

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