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

BSDCCR3.m

Go to the documentation of this file. 
  1. BSDCCR3 ; IHS/ANMC/LJF - CLINIC CAPACITY REPORT CONT. ; 
  1.  ;;5.3;PIMS;;APR 26, 2002
  1.  ;COPY OF SCRPW73 BEFORE PATCH #223
  1.  ;IHS/ANMC/LJF 10/06/2000 changed credit pair to clinic code-name
  1.  ;                        added changes to make report narrower
  1.  ;                        use IHS footer for future & past dates
  1.  ;                         and only at end of report
  1.  ;              8/24/2001 fixed parameter passing, used user's choice
  1.  ;                        shortened display of clinic name
  1.  ;
  1. PRT(SDXM) ;Print report
  1.  ;Input: SDXM='1' for output to mail message text, '0' otherwise
  1.  ;
  1.  N SDX,SDY,SDI,SDP,SDPCT,SDMD,SCNA,SDFOOT,SDT
  1.  S SDOUT=0 D HINI^BSDCCR2,FOOT^BSDCCR5(.SDFOOT)
  1.  S SDMD=$O(^TMP("SD",$J,"")),SDMD=$O(^TMP("SD",$J,SDMD)),SDMD=$L(SDMD)
  1.  I '$D(^TMP("SD",$J)) D  Q
  1.  .D HDR^BSDCCR2(0) S SDX="No data found within the report parameters selected."
  1.  .W !!?(SDIOM-$L(SDX)\2),SDX Q
  1.  S SDIV=9999999 F  S SDIV=$O(^TMP("SD",$J,SDIV)) Q:SDIV=""!SDOUT  D
  1.  .I SDFMT="D" D
  1.  ..S SDCP="" F  S SDCP=$O(^TMP("SD",$J,SDIV,SDCP)) Q:SDCP=""!SDOUT  D
  1.  ...S SCNA="" F  S SCNA=$O(^TMP("SDS",$J,SDCP,SCNA)) Q:SCNA=""!SDOUT  D
  1.  ....S SC=0 F  S SC=$O(^TMP("SDS",$J,SDCP,SCNA,SC)) Q:'SC!SDOUT  D
  1.  .....Q:'$D(^TMP("SD",$J,SDIV,SDCP,SC))
  1.  .....D HDR^BSDCCR2(1,SDIV,SDCP,SC) Q:SDOUT  S SDX=^TMP("SD",$J,SDIV,SDCP,SC)
  1.  .....I $P(SDX,U)+$P(SDX,U,2)+$P(SDX,U,3)'>0 D  Q
  1.  ......S SDY="No availability found"_$S($L($P(SDX,U,4)):": "_$P(SDX,U,4)_".",1:".")
  1.  ......W !!?(SDIOM-$L(SDY)\2),SDY Q
  1.  .....S SDI="" F  S SDI=$O(^TMP("SD",$J,SDIV,SDCP,SC,SDI)) Q:SDI=""!SDOUT  D
  1.  ......S SDX=^TMP("SD",$J,SDIV,SDCP,SC,SDI)
  1.  ......F SDP=1:1 S SDY=$P(SDX,U,SDP) Q:'$L(SDY)!SDOUT  D
  1.  .......S SDY=$TR(SDY,"~","^"),SDT=$$DAY(SDI,SDP,SDBDT)
  1.  .......S SDY=$$TRX(SDY,SDIV,SDCP,SC,$P(SDT,U,2))
  1.  .......;I 'SDXM,$Y>(IOSL-$S(SDPAST:12,1:5)) D  ;IHS/ANMC/LJF 10/6/2000
  1.  .......I 'SDXM,$Y>(IOSL-$S(SDPAST:5,1:5)) D  ;IHS/ANMC/LJF 10/6/2000
  1.  ........;D:SDPAST FOOTER D HDR^BSDCCR2(1,SDIV,SDCP,SC)  ;IHS/ANMC/LJF 10/6/2000
  1.  ........D HDR^BSDCCR2(1,SDIV,SDCP,SC)  ;IHS/ANMC/LJF 10/6/2000
  1.  ........Q
  1.  .......Q:SDOUT
  1.  .......D OUTPUT($P(SDT,U),SDY,SDCOL,4,0,SDPAST,.SDXM)
  1.  .......Q
  1.  ......Q
  1.  .....Q:SDOUT
  1.  .....S SDX=^TMP("SD",$J,SDIV,SDCP,SC),SDX=$$TRX(SDX,SDIV,SDCP,SC)
  1.  .....D OUTPUT("    Clinic Total:",SDX,SDCOL,0,1,SDPAST,.SDXM)
  1.  .....;D:SDPAST FOOTER  ;IHS/ANMC/LJF 10/6/2000
  1.  .....Q
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .Q:SDOUT  D SUM(SDIV) Q
  1.  Q:SDOUT
  1.  ;
  1.  I SDMD D SUM(0)
  1.  Q
  1.  ;
  1. TRX(SDX,SDIV,SDCP,SC,SDT) ;Transform string for output
  1.  ;Input: SDX=output numbers to transform
  1.  ;Input: SDIV=medical center division
  1.  ;Input: SDCP=credit pair (optional)
  1.  ;Input: SC=clinic ien (optional)
  1.  ;Input: SDT=date for detail by day (optional)
  1.  ;Output: (prospective report)=clinic_capacity^available_slots^%_slots_
  1.  ;        available
  1.  ;        (retrospective report)=clinic_capacity^available_slots^
  1.  ;        %_slots_available^clinic_encounters^next_ava._flag_'0'_appts.
  1.  ;        ^next_ava._flag_'0'_ave._wait_time^next_ava._flag_'1'_appts.
  1.  ;        ^next_ava._flag_'1'_ave._wait_time^next_ava._flag_'2'_appts.
  1.  ;        ^next_ava._flag_'2'_ave._wait_time^next_ava._flag_'3'_appts.
  1.  ;        ^next_ava._flag_'3'_ave._wait_time
  1.  ;
  1.  N SDY
  1.  S SDY=$P(SDX,U,2)_U_$P(SDX,U)_U
  1.  S SDY=SDY_$S(+$P(SDX,U,2)=0:0,1:$P(SDX,U)*100\$P(SDX,U,2))
  1.  S SDY=SDY_U_$P(SDX,U,3)
  1.  I '$G(SDCP) S SDY=SDY_U_$G(^TMP("SDNAVA",$J,SDIV)) Q SDY
  1.  I '$G(SC) S SDY=SDY_U_$G(^TMP("SDNAVA",$J,SDIV,SDCP)) Q SDY
  1.  I '$G(SDT) S SDY=SDY_U_$G(^TMP("SDNAVA",$J,SDIV,SDCP,SC)) Q SDY
  1.  S SDY=SDY_U_$G(^TMP("SDNAVA",$J,SDIV,SDCP,SC,SDT))
  1.  Q SDY
  1.  ;
  1. DAY(SDI,SDP,SDBDT) ;Produce date/day value
  1.  ;Input: SDI=array subscript incrementor
  1.  ;Input: SDP=$PIECE of string containing related date data
  1.  ;Input: SDBDT=report start date
  1.  N X1,X2,X,%H,Y,SDT,SDAY
  1.  S X1=SDBDT,X2=-1 D C^%DTC
  1.  S X1=X,X2=SDI*12+SDP D C^%DTC S SDT=X
  1.  D DW^%DTC S SDAY=X,Y=SDT X ^DD("DD")
  1.  Q Y_" "_$S($E(SDT,6)=0:"-",1:"")_"- "_SDAY_U_SDT
  1.  ;
  1. SUM(SDIV) ;Print division/facility summary
  1.  ;Input: SDDIV=division name^number (or '0' for facility total)
  1.  ;
  1.  N SDY,SCNA,SDI
  1.  S SDCP="",SDHD=$S(SDIV=0:3,1:2) D HDR^BSDCCR2(SDHD,SDIV)
  1.  F  S SDCP=$O(^TMP("SD",$J,SDIV,SDCP)) Q:SDCP=""!SDOUT  D
  1.  .S SDX=^TMP("SD",$J,SDIV,SDCP),SDY=$G(^TMP("SD",$J,SDIV))
  1.  .F SDI=1:1:3 S $P(SDY,U,SDI)=$P(SDY,U,SDI)+$P(SDX,U,SDI)
  1.  .S ^TMP("SD",$J,SDIV)=SDY
  1.  .I SDFMT="S" Q:$P(SDX,U)+$P(SDX,U,2)+$P(SDX,U,3)'>0
  1.  .I SDMD S SDY=$G(^TMP("SD",$J,0,SDCP)) D
  1.  ..F SDI=1:1:3 S $P(SDY,U,SDI)=$P(SDY,U,SDI)+$P(SDX,U,SDI)
  1.  ..S ^TMP("SD",$J,0,SDCP)=SDY
  1.  .S SDY=$$OTX("CP"),SDX=$$TRX(SDX,SDIV,SDCP)
  1.  .D OUTPUT(SDY,SDX,SDCOL,0,1,SDPAST,.SDXM)
  1.  .S SCNA="" F  S SCNA=$O(^TMP("SDS",$J,SDCP,SCNA)) Q:SCNA=""!SDOUT  D
  1.  ..S SC=0 F  S SC=$O(^TMP("SDS",$J,SDCP,SCNA,SC)) Q:'SC!SDOUT  D
  1.  ...S SDX=$G(^TMP("SD",$J,SDIV,SDCP,SC))
  1.  ...I SDFMT="S" Q:$P(SDX,U)+$P(SDX,U,2)+$P(SDX,U,3)'>0
  1.  ...;I 'SDXM,$Y>(IOSL-$S(SDPAST:12,1:5)) D      ;IHS/ANMC/LJF 10/6/2000
  1.  ...I 'SDXM,$Y>(IOSL-$S(SDPAST:5,1:5)) D        ;IHS/ANMC/LJF 10/6/2000
  1.  ....;D:SDPAST FOOTER D HDR^BSDCCR2(SDHD,SDIV)  ;IHS/ANMC/LJF 10/6/2000
  1.  ....D HDR^BSDCCR2(SDHD,SDIV)                   ;IHS/ANMC/LJF 10/6/2000
  1.  ....Q
  1.  ...Q:SDOUT
  1.  ...I SDMD S SDY=$G(^TMP("SD",$J,0,SDCP,SC)) D
  1.  ....F SDI=1:1:3 S $P(SDY,U,SDI)=$P(SDY,U,SDI)+$P(SDX,U,SDI)
  1.  ....S ^TMP("SD",$J,0,SDCP,SC)=SDY
  1.  ....Q
  1.  ...;IHS/ANMC/LJF 10/6/2000 modified lines below
  1.  ...;S SDY=$$OTX("CL"),SDX=$$TRX(SDX,SDIV,SDCP,SC)
  1.  ...;D OUTPUT(SDY,SDX,SDCOL,4,0,SDPAST,.SDXM)
  1.  ...S SDY="  "_$$OTX("CL"),SDX=$$TRX(SDX,SDIV,SDCP,SC)
  1.  ...D OUTPUT(SDY,SDX,SDCOL,0,0,SDPAST,.SDXM)
  1.  ...;IHS/ANMC/LJF 10/6/2000 end of code changes
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  Q:SDOUT  S SDX=$G(^TMP("SD",$J,SDIV)),SDX=$$TRX(SDX,SDIV)
  1.  S SDY=$S(SDIV=0:"Facility",1:"Division")_" total:" D OUTPUT(SDY,SDX,SDCOL,0,1,SDPAST,.SDXM)
  1.  ;D:SDPAST FOOTER  ;IHS/ANMC/LJF 10/6/2000
  1.  I $Y>(IOSL-$S(SDPAST:9,1:5)) D HDR^BSDCCR2(SDHD,SDIV)  ;IHS/ANMC/LJF 10/6/2000
  1.  D FOOTER          ;IHS/ANMC/LJF 10/6/2000
  1.  Q
  1.  ;
  1.  N SDI
  1.  I SDXM D  Q
  1.  .D XMTX(" ") F SDI=1:1:7 D XMTX(SDFOOT(SDI))
  1.  .Q
  1.  ;F SDI=1:1:80 Q:$Y>(IOSL-10)  W !            ;IHS/ANMC/LJF 10/6/2000
  1.  ;F SDI=1:1:7 W !,SDFOOT(SDI)                 ;IHS/ANMC/LJF 10/6/2000
  1.  F SDI=1:1:$S(SDPAST:9,1:5) W !,SDFOOT(SDI)   ;IHS/ANMC/LJF 10/6/2000
  1.  Q
  1.  ;
  1. OUTPUT(SDTX,SDX,SDCOL,SDC,SDL,SDPAST,SDXM) ;Write output or load summary message
  1.  ;Input: SDTX=category text value
  1.  ;Input: SDX=output count values
  1.  ;Input: SDCOL=margin adjusted column control
  1.  ;Input: SDC=column to start line
  1.  ;Input: SDL=number of additional linefeeds
  1.  ;Input: SDPAST='0' if dates > TODAY, '1' otherwise
  1.  ;Input: SDXM=mail message line number message text (optional)
  1.  ;
  1.  N SDI,SDPCT
  1.  G:$G(SDXM) OUTXM F SDI=1:1:SDL W !
  1.  ;
  1.  ;IHS/ANMC/LJF 10/6/2000; 8/24/2001
  1.  ;W !?(SDCOL+SDC),SDTX
  1.  ;F SDI=1:1:$S(SDPAST:12,1:3) D
  1.  W !?(SDCOL+SDC),$E(SDTX,1,27)
  1.  F SDI=1:1:$S(SDPAST:6,1:3) D
  1.  .W ?(SDCOL+34+(SDI-1*8)),$J(+$P(SDX,U,SDI),$S(SDI=3:7,1:8),$$OPD())_$S(SDI=3:"%",1:"")
  1.  .Q
  1.  ;IHS/ANMC/LJF 10/6/2000, 8/24/2001 end of mods
  1.  Q
  1.  ;
  1. OPD() ;Output decimal places
  1.  Q $S(SDI<6:0,SDI#2:0,1:1)
  1.  ;
  1. OUTXM ;Load bulletin message text
  1.  ;Output: ^TMP("SDXM",$J,SDXM)=mail message text line
  1.  N SDZ S:SDC<1 SDC=1
  1.  F SDI=1:1:SDL D XMTX("")
  1.  S SDZ="",$E(SDZ,SDC)=SDTX
  1.  F SDI=1:1:$S(SDPAST:12,1:3) D
  1.  .S $E(SDZ,(34+(SDI-1*8)))=$J(+$P(SDX,U,SDI),$S(SDI=3:7,1:8),$$OPD())_$S(SDI=3:"%",1:"")
  1.  D XMTX(SDZ)
  1.  Q
  1.  ;
  1. XMTX(SDX) ;Set mail message text line
  1.  ;Input: SDX=text value
  1.  S ^TMP("SDXM",$J,SDXM)=SDX,SDXM=SDXM+1 Q
  1.  ;
  1. OTX(SDSORT)    ;Produce output text for clinic or credit pair
  1.  ;Input: SDSORT='CL' for clinic name, 'CP' for credit pair
  1.  N SDZ,SDSC1,SDSC2
  1.  I SDSORT="CL" S SDZ=$P($G(^SC(+SC,0)),U) S:'$L(SDZ) SDZ="UNKNOWN" Q SDZ
  1.  S SDSC1=$O(^DIC(40.7,"C",$E(SDCP,1,3),""))
  1.  Q SDCP_"-"_$E($$GET1^DIQ(40.7,SDSC1,.01),1,20)   ;IHS/ANMC/LJF 10/6/2000
  1.  ;
  1.  S SDSC1=$P($G(^DIC(40.7,+SDSC1,0)),U),SDSC1=$TR(SDSC1,"/","-")
  1.  S:'$L(SDSC1) SDSC1="UNKNOWN"
  1.  I $E(SDCP,4,6)="000" S SDSC2="(NONE)" G CPO1
  1.  S SDSC2=$O(^DIC(40.7,"C",$E(SDCP,4,6),""))
  1.  S SDSC2=$P($G(^DIC(40.7,+SDSC2,0)),U),SDSC2=$TR(SDSC2,"/","-")
  1.  S:'$L(SDSC2) SDSC2="UNKNOWN"
  1. CPO1 I $L(SDSC1)<13 S SDZ=SDSC1_"/"_$E(SDSC2,1,(13+(13-$L(SDSC1)))) G CPOTQ
  1.  I $L(SDSC2)<13 S SDZ=$E(SDSC1,1,(13+(13-$L(SDSC2))))_"/"_SDSC2 G CPOTQ
  1.  S SDZ=$E(SDSC1,1,13)_"/"_$E(SDSC2,1,13)
  1. CPOTQ Q SDCP_" "_SDZ
  1.  ;
  1. HDRXM ;Create header in mail message
  1.  ;
  1.  N SDX,SDI,SDZ
  1.  I SDPAGE>1 F SDI=1:1:5 D XMTX("")
  1.  D XMTX($E(SDLINE,1,$S(SDPAST:130,1:79)))
  1.  S SDZ="",$E(SDZ,($S(SDPAST:130,1:79)-$L(SDTITL)\2))=SDTITL D XMTX(SDZ)
  1.  D HDRX^BSDCCR2(SDTY) S SDI=0
  1.  F  S SDI=$O(SDTIT(SDI)) Q:'SDI  S SDZ="" D
  1.  .S $E(SDZ,($S(SDPAST:130,1:79)-$L(SDTIT(SDI))\2))=SDTIT(SDI) D XMTX(SDZ)
  1.  .Q
  1.  D XMTX($E(SDLINE,1,$S(SDPAST:130,1:79))),XMTX("For clinic availability dates "_SDPBDT_" through "_SDPEDT)
  1.  S SDZ="Date extracted: "_SDPNOW D XMTX(SDZ),XMTX($E(SDLINE,1,$S(SDPAST:130,1:79)))
  1.  S SDPAGE=SDPAGE+1 D:SDTY SUBTXM(SDTY) Q
  1.  ;
  1. SUBTXM(SDTY) ;Create message header subtitles
  1.  N SDI
  1.  S SDZ="",$E(SDZ,44)="Avail.",$E(SDZ,54)="Pct."
  1.  I SDPAST F SDI=0:1:3 D
  1.  .S $E(SDZ,(SDCOL+68+(16*SDI)))="---Type '"_SDI_"'---"
  1.  .Q
  1.  D XMTX(SDZ)
  1.  S SDZ="" I SDTY>1 S SDZ="Credit Pair"
  1.  S $E(SDZ,36)="Clinic",$E(SDZ,45)="Appt.",$E(SDZ,53)="Slots"
  1.  I SDPAST D
  1.  .S $E(SDZ,60)="Clinic"
  1.  .F SDI=0:1:3 S $E(SDZ,(SDCOL+68+(16*SDI)))="Sched.    Wait"
  1.  .Q
  1.  D XMTX(SDZ)
  1.  S SDZ="",$E(SDZ,4)=$S(SDTY=1:"Availability Date",1:"Clinic Name")
  1.  S $E(SDZ,34)="Capacity",$E(SDZ,45)="Slots",$E(SDZ,52)="Avail."
  1.  I SDPAST D
  1.  .S $E(SDZ,62)="Enc."
  1.  .F SDI=0:1:3 S $E(SDZ,(SDCOL+68+(16*SDI)))="Appts.    Time"
  1.  .Q
  1.  D XMTX(SDZ)
  1.  S SDZ="",$E(SDZ,$S(SDTY>1:1,1:4))=$E(SDLINE,1,$S(SDPAST:130-$S(SDTY=1:4,1:0),1:58))
  1.  D XMTX(SDZ)
  1.  Q