- SCRPW73 ;BP-CIOFO/KEITH,ESW - Clinic appointment availability extract (cont.) ; 5/28/03 2:27pm
- ;;5.3;Scheduling;**192,206,223,249,291**;AUG 13, 1993
- ;
- PRT(SDXM,SDREPORT) ;Print report
- ;Input: SDXM='1' for output to mail message text, '0' otherwise
- ;Input: SDREPORT=report element to print
- ;
- N SDX,SDY,SDI,SDP,SDPCT,SDMD,SCNA,SDT,SDFLEN
- S SDOUT=0,SDFLEN=$S('SDPAST:5,SDREPORT#1:12,1:11)
- S SDMD=$O(^TMP("SD",$J,"")),SDMD=$O(^TMP("SD",$J,SDMD)),SDMD=$L(SDMD)
- I '$D(^TMP("SD",$J)),$G(SDREPORT)'=5 D Q
- .D HDR^SCRPW76(0,SDREPORT) S SDX="No data found within the report parameters selected."
- .W !!?(SDIOM-$L(SDX)\2),SDX Q
- I '$D(^TMP("SDIPLST",$J)),$G(SDREPORT)=5 D Q
- .D HDR^SCRPW76(0,SDREPORT) S SDX="No data found within the report parameters selected."
- .W !!?(SDIOM-$L(SDX)\2),SDX Q
- I SDREPORT=5 D PRT5^SCRPW78 Q
- S SDIV=9999999 F S SDIV=$O(^TMP("SD",$J,SDIV)) Q:SDIV=""!SDOUT D
- .I SDFMT="D" D
- ..S SDCP="" F S SDCP=$O(^TMP("SD",$J,SDIV,SDCP)) Q:SDCP=""!SDOUT D
- ...S SCNA="" F S SCNA=$O(^TMP("SDS",$J,SDCP,SCNA)) Q:SCNA=""!SDOUT D
- ....S SC=0 F S SC=$O(^TMP("SDS",$J,SDCP,SCNA,SC)) Q:'SC!SDOUT D
- .....Q:'$D(^TMP("SD",$J,SDIV,SDCP,SC))
- .....D HDR^SCRPW76(1,SDREPORT,SDIV,SDCP,SC) Q:SDOUT
- .....I SDREPORT=4 D OUT4^SCRPW77 Q
- .....S SDX=^TMP("SD",$J,SDIV,SDCP,SC)
- .....I $P(SDX,U)+$P(SDX,U,2)+$P(SDX,U,3)'>0,'$D(^TMP("SDNAVA",$J,SDIV,SDCP,SC)) D Q
- ......S SDY="No availability found"_$S($L($P(SDX,U,4)):": "_$P(SDX,U,4)_".",1:".")
- ......W !!?(SDIOM-$L(SDY)\2),SDY Q
- .....S SDI="" F S SDI=$O(^TMP("SD",$J,SDIV,SDCP,SC,SDI)) Q:SDI=""!SDOUT D
- ......S SDX=^TMP("SD",$J,SDIV,SDCP,SC,SDI)
- ......F SDP=1:1 S SDY=$P(SDX,U,SDP) Q:'$L(SDY)!SDOUT D
- .......S SDY=$TR(SDY,"~","^"),SDT=$$DAY(SDI,SDP,SDBDT)
- .......S SDY=$$TRX(SDREPORT,SDY,SDIV,SDCP,SC,$P(SDT,U,2))
- .......I 'SDXM,$Y>(IOSL-SDFLEN) D
- ........D:SDPAST FOOTER^SCRPW77(SDREPORT) D HDR^SCRPW76(1,SDREPORT,SDIV,SDCP,SC)
- ........Q
- .......Q:SDOUT
- .......D OUTPUT(SDREPORT,$P(SDT,U),SDY,SDCOL,4,0,SDPAST,.SDXM)
- .......Q
- ......Q
- .....Q:SDOUT
- .....S SDX=^TMP("SD",$J,SDIV,SDCP,SC),SDX=$$TRX(SDREPORT,SDX,SDIV,SDCP,SC)
- .....D OUTPUT(SDREPORT," Clinic Total:",SDX,SDCOL,0,1,SDPAST,.SDXM)
- .....D:SDPAST FOOTER^SCRPW77(SDREPORT)
- .....Q
- ....Q
- ...Q
- ..Q
- .Q:SDOUT D SUM(SDIV,SDREPORT) Q
- Q:SDOUT
- ;
- I SDMD D SUM(0,SDREPORT)
- Q
- ;
- TRX(SDREPORT,SDX,SDIV,SDCP,SC,SDT) ;Transform string for output
- ;Input: SDREPORT=report element to print
- ;Input: SDX=output numbers to transform
- ;Input: SDIV=medical center division
- ;Input: SDCP=credit pair (optional)
- ;Input: SC=clinic ien (optional)
- ;Input: SDT=date for detail by day (optional)
- ;Output: string of output values for specified SDREPORT type
- ;
- N SDY
- I SDREPORT=1 S SDY=$$TRX1()
- I SDREPORT=2 S SDY=$$TRX2()
- I SDREPORT=3 S SDY=$$TRX3()
- Q SDY
- ;
- TRX1() N SDZ S SDZ=""
- S SDY=$P(SDX,U,2)_U_$P(SDX,U)_U
- S SDY=SDY_$S(+$P(SDX,U,2)=0:0,1:$P(SDX,U)*100\$P(SDX,U,2))
- S SDY=SDY_U_$P(SDX,U,3) D
- .I '$G(SDCP) S SDZ=$G(^TMP("SDNAVA",$J,SDIV)) Q
- .I '$G(SC) S SDZ=$G(^TMP("SDNAVA",$J,SDIV,SDCP)) Q
- .I '$G(SDT) S SDZ=$G(^TMP("SDNAVA",$J,SDIV,SDCP,SC)) Q
- .S SDZ=$G(^TMP("SDNAVA",$J,SDIV,SDCP,SC,SDT)) Q
- S SDY=SDY_U_$P(SDZ,U,1,8)_U_$P(SDZ,U,38,39)
- Q SDY
- ;
- TRX2() I '$G(SDCP) S SDY=$P($G(^TMP("SDNAVA",$J,SDIV)),U,9,20) Q SDY
- I '$G(SC) S SDY=$P($G(^TMP("SDNAVA",$J,SDIV,SDCP)),U,9,20) Q SDY
- I '$G(SDT) S SDY=$P($G(^TMP("SDNAVA",$J,SDIV,SDCP,SC)),U,9,20) Q SDY
- S SDY=$P($G(^TMP("SDNAVA",$J,SDIV,SDCP,SC,SDT)),U,9,20)
- Q SDY
- ;
- TRX3() I '$G(SDCP) S SDY=$P($G(^TMP("SDNAVA",$J,SDIV)),U,21,37) Q SDY
- I '$G(SC) S SDY=$P($G(^TMP("SDNAVA",$J,SDIV,SDCP)),U,21,37) Q SDY
- I '$G(SDT) S SDY=$P($G(^TMP("SDNAVA",$J,SDIV,SDCP,SC)),U,21,37) Q SDY
- S SDY=$P($G(^TMP("SDNAVA",$J,SDIV,SDCP,SC,SDT)),U,21,37)
- Q SDY
- ;
- DAY(SDI,SDP,SDBDT) ;Produce date/day value
- ;Input: SDI=array subscript incrementor
- ;Input: SDP=$PIECE of string containing related date data
- ;Input: SDBDT=report start date
- N X1,X2,X,%H,Y,SDT,SDAY
- S X1=SDBDT,X2=-1 D C^%DTC
- S X1=X,X2=SDI*12+SDP D C^%DTC S SDT=X
- D DW^%DTC S SDAY=X,Y=SDT X ^DD("DD")
- Q Y_" "_$S($E(SDT,6)=0:"-",1:"")_"- "_SDAY_U_SDT
- ;
- SUM(SDIV,SDREPORT) ;Print division/facility summary
- ;Input: SDDIV=division name^number (or '0' for facility total)
- ;Input: SDREPORT=report element to print
- ;
- I SDREPORT=4!(SDREPORT=5) Q
- N SDY,SCNA,SDI
- S SDCP="",SDHD=$S(SDIV=0:3,1:2) D HDR^SCRPW76(SDHD,SDREPORT,SDIV)
- F S SDCP=$O(^TMP("SD",$J,SDIV,SDCP)) Q:SDCP=""!SDOUT D
- .S SDX=^TMP("SD",$J,SDIV,SDCP),SDY=$G(^TMP("SD",$J,SDIV))
- .F SDI=1:1:3 S $P(SDY,U,SDI)=$P(SDY,U,SDI)+$P(SDX,U,SDI)
- .S ^TMP("SD",$J,SDIV)=SDY
- .Q:'$$DATA(1) ;Quit if no data
- .I SDMD S SDY=$G(^TMP("SD",$J,0,SDCP)) D
- ..F SDI=1:1:3 S $P(SDY,U,SDI)=$P(SDY,U,SDI)+$P(SDX,U,SDI)
- ..S ^TMP("SD",$J,0,SDCP)=SDY
- .S SDY=$$OTX("CP"),SDX=$$TRX(SDREPORT,SDX,SDIV,SDCP)
- .D OUTPUT(SDREPORT,SDY,SDX,SDCOL,0,1,SDPAST,.SDXM)
- .S SCNA="" F S SCNA=$O(^TMP("SDS",$J,SDCP,SCNA)) Q:SCNA=""!SDOUT D
- ..S SC=0 F S SC=$O(^TMP("SDS",$J,SDCP,SCNA,SC)) Q:'SC!SDOUT D
- ...S SDX=$G(^TMP("SD",$J,SDIV,SDCP,SC))
- ...Q:'$$DATA(2) ;Quit if no data
- ...I 'SDXM,$Y>(IOSL-SDFLEN) D
- ....D:SDPAST FOOTER^SCRPW77(SDREPORT) D HDR^SCRPW76(SDHD,SDREPORT,SDIV)
- ....Q
- ...Q:SDOUT
- ...I SDMD S SDY=$G(^TMP("SD",$J,0,SDCP,SC)) D
- ....F SDI=1:1:3 S $P(SDY,U,SDI)=$P(SDY,U,SDI)+$P(SDX,U,SDI)
- ....S ^TMP("SD",$J,0,SDCP,SC)=SDY
- ....Q
- ...S SDY=$$OTX("CL"),SDX=$$TRX(SDREPORT,SDX,SDIV,SDCP,SC)
- ...D OUTPUT(SDREPORT,SDY,SDX,SDCOL,4,0,SDPAST,.SDXM)
- ...Q
- ..Q
- .Q
- Q:SDOUT S SDX=$G(^TMP("SD",$J,SDIV)),SDX=$$TRX(SDREPORT,SDX,SDIV)
- I $G(SDFMT)="S"&($G(SDFMTS)="CP") D:SDPAST FOOTER^SCRPW77(SDREPORT) Q
- S SDY=$S(SDIV=0:"Facility",1:"Division")_" total:" D OUTPUT(SDREPORT,SDY,SDX,SDCOL,0,1,SDPAST,.SDXM,1)
- D:SDPAST FOOTER^SCRPW77(SDREPORT)
- Q
- ;
- DATA(SDS) ;Check for data to print
- ;Input: SDS=subscript level
- ;Output: '1' if data, '0' otherwise
- N SDCK,SDNODE,SDI,SDCT S (SDCT,SDCK)=0
- Q:SDFMT'="S" 1
- I 'SDPAST S SDCK=($P(SDX,U)+$P(SDX,U,2)+$P(SDX,U,3)>0) Q SDCK
- I $P(SDX,U)+$P(SDX,U,2)+$P(SDX,U,3)>0 Q 1
- I SDS=1 S SDNODE=$G(^TMP("SDNAVA",$J,SDIV,SDCP))
- I SDS=2 S SDNODE=$G(^TMP("SDNAVA",$J,SDIV,SDCP,SC))
- F SDI=1:1:39 S SDCT=SDCT+$P(SDNODE,U,SDI)
- S SDCK=SDCT>0
- Q SDCK
- ;
- OUTPUT(SDREPORT,SDTX,SDX,SDCOL,SDC,SDL,SDPAST,SDXM,SDTL) ;Write output or load summary message
- ;Input: SDREPORT=report element to print
- ;Input: SDTX=category text value
- ;Input: SDX=output count values
- ;Input: SDCOL=margin adjusted column control
- ;Input: SDC=column to start line
- ;Input: SDL=number of additional linefeeds
- ;Input: SDPAST='0' if dates > TODAY, '1' otherwise
- ;Input: SDXM=mail message line number message text (optional)
- ;Input: SDTL='1' if this is a totals line
- ;
- N SDI,SDPCT
- G:$G(SDXM) OUTXM F SDI=1:1:SDL W !
- D:SDREPORT=1 OUT1 D:SDREPORT=2 OUT2 D:SDREPORT=3 OUT3
- Q
- ;
- OUT1 N SDL1,SDL2,SDL3
- W !?(SDCOL+SDC),SDTX
- F SDI=1:1:$S(SDPAST:12,1:3) D MANI(SDX,SDI,$G(SDTL)) D
- .W ?(SDCOL+34+SDL1+(SDI-1*7)),$J(+$P(SDX,U,SDI),$S(((SDI<3)&(SDL3>7)):SDL3,SDI=3:(6-SDL1),1:7),$$OPD())_$S(SDI=3:"%",1:"")
- .Q
- I SDPAST F SDI=0,1 D
- .W ?(SDCOL+118+(SDI*7)),$J(+$P(SDX,U,13+SDI),6,0)_"%"
- .Q
- Q
- ;
- MANI(SDX,SDI,SDTL) ;Manipulate column position for large totals
- ;
- S (SDL1,SDL2)=0,SDL3=$L($P(SDX,U,SDI))
- I $G(SDTL) D
- .I SDI=1,SDL3>7 S SDL1=(7-SDL3)
- .I SDI=2,SDL3>6 S SDL1=1
- .I SDI=3 S SDL1=3
- .Q
- Q
- ;
- OUT2 W !?(SDCOL+SDC),SDTX
- F SDI=0:1:5 D
- .W ?(36+(SDI*16)),$J(+$P(SDX,U,(1+(SDI*2))),8,0)
- .W ?(44+(SDI*16)),$J(+$P(SDX,U,(2+(SDI*2))),8,1)
- .Q
- Q
- ;
- OUT3 W !?(SDCOL+SDC),SDTX
- W ?30,$J(+$P(SDX,U),6,0),?36,$J(+$P(SDX,U,2),6,1)
- F SDI=0:1:4 D
- .W ?(42+(SDI*18)),$J(+$P(SDX,U,(3+(SDI*3))),6,0)
- .W ?(48+(SDI*18)),$J(+$P(SDX,U,(4+(SDI*3))),6,1)
- .W ?(54+(SDI*18)),$J(+$P(SDX,U,(5+(SDI*3))),6,1)
- .Q
- Q
- ;
- OPD() ;Output decimal places
- Q $S(SDI<6:0,SDI#2:0,1:1)
- ;
- OUTXM ;Load bulletin message text
- ;Output: ^TMP("SDXM",$J,SDXM)=mail message text line
- N SDZ S:SDC<1 SDC=1
- F SDI=1:1:SDL D XMTX("")
- D:SDREPORT=1 OUTXM1 D:SDREPORT=2 OUTXM2 D:SDREPORT=3 OUTXM3
- Q
- ;
- OUTXM1 N SDL1,SDL2,SDL3
- S SDZ="",$E(SDZ,SDC)=SDTX
- F SDI=1:1:$S(SDPAST:12,1:3) D MANI(SDX,SDI,$G(SDTL)) D
- .S $E(SDZ,(35+SDL1+(SDI-1*7)))=$J(+$P(SDX,U,SDI),$S(((SDI<3)&(SDL3>7)):SDL3,SDI=3:(6-SDL1),1:7),$$OPD())_$S(SDI=3:"%",1:"")
- I SDPAST F SDI=0,1 D
- .S $E(SDZ,(119+(SDI*7)))=$J(+$P(SDX,U,13+SDI),6,0)_"%"
- D XMTX(SDZ)
- Q
- ;
- OUTXM2 S SDZ="",$E(SDZ,SDC)=SDTX
- F SDI=0:1:5 D
- .S $E(SDZ,(37+(SDI*16)))=$J(+$P(SDX,U,(1+(SDI*2))),8,0)
- .S $E(SDZ,(45+(SDI*16)))=$J(+$P(SDX,U,(2+(SDI*2))),8,1)
- .Q
- D XMTX(SDZ)
- Q
- ;
- OUTXM3 S SDZ="",$E(SDZ,SDC)=SDTX
- S $E(SDZ,31)=$J(+$P(SDX,U),6,0),$E(SDZ,37)=$J(+$P(SDX,U,2),6,1)
- F SDI=0:1:4 D
- .S $E(SDZ,(43+(SDI*18)))=$J(+$P(SDX,U,(3+(SDI*3))),6,0)
- .S $E(SDZ,(49+(SDI*18)))=$J(+$P(SDX,U,(4+(SDI*3))),6,1)
- .S $E(SDZ,(55+(SDI*18)))=$J(+$P(SDX,U,(5+(SDI*3))),6,1)
- .Q
- D XMTX(SDZ)
- Q
- ;
- XMTX(SDX) ;Set mail message text line
- ;Input: SDX=text value
- S ^TMP("SDXM",$J,SDXM)=SDX,SDXM=SDXM+1 Q
- ;
- OTX(SDSORT) ;Produce output text for clinic or credit pair
- ;Input: SDSORT='CL' for clinic name, 'CP' for credit pair
- N SDZ,SDSC1,SDSC2
- I SDSORT="CL" D Q SDZ
- .S SDZ=$P($G(^SC(+SC,0)),U) S:'$L(SDZ) SDZ="UNKNOWN"
- .I SDREPORT=3 S SDZ=$E(SDZ,1,26)
- .Q
- S SDSC1=$O(^DIC(40.7,"C",$E(SDCP,1,3),""))
- S SDSC1=$P($G(^DIC(40.7,+SDSC1,0)),U),SDSC1=$TR(SDSC1,"/","-")
- S:'$L(SDSC1) SDSC1="UNKNOWN"
- I $E(SDCP,4,6)="000" S SDSC2="(NONE)" G CPO1
- S SDSC2=$O(^DIC(40.7,"C",$E(SDCP,4,6),""))
- S SDSC2=$P($G(^DIC(40.7,+SDSC2,0)),U),SDSC2=$TR(SDSC2,"/","-")
- S:'$L(SDSC2) SDSC2="UNKNOWN"
- CPO1 I $L(SDSC1)<13 S SDZ=SDSC1_"/"_$E(SDSC2,1,(13+(13-$L(SDSC1)))) G CPOTQ
- I $L(SDSC2)<13 S SDZ=$E(SDSC1,1,(13+(13-$L(SDSC2))))_"/"_SDSC2 G CPOTQ
- S SDZ=$E(SDSC1,1,13)_"/"_$E(SDSC2,1,13)
- CPOTQ S SDZ=SDCP_" "_SDZ I SDREPORT=3 S SDZ=$E(SDZ,1,30)
- Q SDZ
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPW73 9992 printed Feb 19, 2025@00:10:32 Page 2
- SCRPW73 ;BP-CIOFO/KEITH,ESW - Clinic appointment availability extract (cont.) ; 5/28/03 2:27pm
- +1 ;;5.3;Scheduling;**192,206,223,249,291**;AUG 13, 1993
- +2 ;
- PRT(SDXM,SDREPORT) ;Print report
- +1 ;Input: SDXM='1' for output to mail message text, '0' otherwise
- +2 ;Input: SDREPORT=report element to print
- +3 ;
- +4 NEW SDX,SDY,SDI,SDP,SDPCT,SDMD,SCNA,SDT,SDFLEN
- +5 SET SDOUT=0
- SET SDFLEN=$SELECT('SDPAST:5,SDREPORT#1:12,1:11)
- +6 SET SDMD=$ORDER(^TMP("SD",$JOB,""))
- SET SDMD=$ORDER(^TMP("SD",$JOB,SDMD))
- SET SDMD=$LENGTH(SDMD)
- +7 IF '$DATA(^TMP("SD",$JOB))
- IF $GET(SDREPORT)'=5
- Begin DoDot:1
- +8 DO HDR^SCRPW76(0,SDREPORT)
- SET SDX="No data found within the report parameters selected."
- +9 WRITE !!?(SDIOM-$LENGTH(SDX)\2),SDX
- QUIT
- End DoDot:1
- QUIT
- +10 IF '$DATA(^TMP("SDIPLST",$JOB))
- IF $GET(SDREPORT)=5
- Begin DoDot:1
- +11 DO HDR^SCRPW76(0,SDREPORT)
- SET SDX="No data found within the report parameters selected."
- +12 WRITE !!?(SDIOM-$LENGTH(SDX)\2),SDX
- QUIT
- End DoDot:1
- QUIT
- +13 IF SDREPORT=5
- DO PRT5^SCRPW78
- QUIT
- +14 SET SDIV=9999999
- FOR
- SET SDIV=$ORDER(^TMP("SD",$JOB,SDIV))
- if SDIV=""!SDOUT
- QUIT
- Begin DoDot:1
- +15 IF SDFMT="D"
- Begin DoDot:2
- +16 SET SDCP=""
- FOR
- SET SDCP=$ORDER(^TMP("SD",$JOB,SDIV,SDCP))
- if SDCP=""!SDOUT
- QUIT
- Begin DoDot:3
- +17 SET SCNA=""
- FOR
- SET SCNA=$ORDER(^TMP("SDS",$JOB,SDCP,SCNA))
- if SCNA=""!SDOUT
- QUIT
- Begin DoDot:4
- +18 SET SC=0
- FOR
- SET SC=$ORDER(^TMP("SDS",$JOB,SDCP,SCNA,SC))
- if 'SC!SDOUT
- QUIT
- Begin DoDot:5
- +19 if '$DATA(^TMP("SD",$JOB,SDIV,SDCP,SC))
- QUIT
- +20 DO HDR^SCRPW76(1,SDREPORT,SDIV,SDCP,SC)
- if SDOUT
- QUIT
- +21 IF SDREPORT=4
- DO OUT4^SCRPW77
- QUIT
- +22 SET SDX=^TMP("SD",$JOB,SDIV,SDCP,SC)
- +23 IF $PIECE(SDX,U)+$PIECE(SDX,U,2)+$PIECE(SDX,U,3)'>0
- IF '$DATA(^TMP("SDNAVA",$JOB,SDIV,SDCP,SC))
- Begin DoDot:6
- +24 SET SDY="No availability found"_$SELECT($LENGTH($PIECE(SDX,U,4)):": "_$PIECE(SDX,U,4)_".",1:".")
- +25 WRITE !!?(SDIOM-$LENGTH(SDY)\2),SDY
- QUIT
- End DoDot:6
- QUIT
- +26 SET SDI=""
- FOR
- SET SDI=$ORDER(^TMP("SD",$JOB,SDIV,SDCP,SC,SDI))
- if SDI=""!SDOUT
- QUIT
- Begin DoDot:6
- +27 SET SDX=^TMP("SD",$JOB,SDIV,SDCP,SC,SDI)
- +28 FOR SDP=1:1
- SET SDY=$PIECE(SDX,U,SDP)
- if '$LENGTH(SDY)!SDOUT
- QUIT
- Begin DoDot:7
- +29 SET SDY=$TRANSLATE(SDY,"~","^")
- SET SDT=$$DAY(SDI,SDP,SDBDT)
- +30 SET SDY=$$TRX(SDREPORT,SDY,SDIV,SDCP,SC,$PIECE(SDT,U,2))
- +31 IF 'SDXM
- IF $Y>(IOSL-SDFLEN)
- Begin DoDot:8
- +32 if SDPAST
- DO FOOTER^SCRPW77(SDREPORT)
- DO HDR^SCRPW76(1,SDREPORT,SDIV,SDCP,SC)
- +33 QUIT
- End DoDot:8
- +34 if SDOUT
- QUIT
- +35 DO OUTPUT(SDREPORT,$PIECE(SDT,U),SDY,SDCOL,4,0,SDPAST,.SDXM)
- +36 QUIT
- End DoDot:7
- +37 QUIT
- End DoDot:6
- +38 if SDOUT
- QUIT
- +39 SET SDX=^TMP("SD",$JOB,SDIV,SDCP,SC)
- SET SDX=$$TRX(SDREPORT,SDX,SDIV,SDCP,SC)
- +40 DO OUTPUT(SDREPORT," Clinic Total:",SDX,SDCOL,0,1,SDPAST,.SDXM)
- +41 if SDPAST
- DO FOOTER^SCRPW77(SDREPORT)
- +42 QUIT
- End DoDot:5
- +43 QUIT
- End DoDot:4
- +44 QUIT
- End DoDot:3
- +45 QUIT
- End DoDot:2
- +46 if SDOUT
- QUIT
- DO SUM(SDIV,SDREPORT)
- QUIT
- End DoDot:1
- +47 if SDOUT
- QUIT
- +48 ;
- +49 IF SDMD
- DO SUM(0,SDREPORT)
- +50 QUIT
- +51 ;
- TRX(SDREPORT,SDX,SDIV,SDCP,SC,SDT) ;Transform string for output
- +1 ;Input: SDREPORT=report element to print
- +2 ;Input: SDX=output numbers to transform
- +3 ;Input: SDIV=medical center division
- +4 ;Input: SDCP=credit pair (optional)
- +5 ;Input: SC=clinic ien (optional)
- +6 ;Input: SDT=date for detail by day (optional)
- +7 ;Output: string of output values for specified SDREPORT type
- +8 ;
- +9 NEW SDY
- +10 IF SDREPORT=1
- SET SDY=$$TRX1()
- +11 IF SDREPORT=2
- SET SDY=$$TRX2()
- +12 IF SDREPORT=3
- SET SDY=$$TRX3()
- +13 QUIT SDY
- +14 ;
- TRX1() NEW SDZ
- SET SDZ=""
- +1 SET SDY=$PIECE(SDX,U,2)_U_$PIECE(SDX,U)_U
- +2 SET SDY=SDY_$SELECT(+$PIECE(SDX,U,2)=0:0,1:$PIECE(SDX,U)*100\$PIECE(SDX,U,2))
- +3 SET SDY=SDY_U_$PIECE(SDX,U,3)
- Begin DoDot:1
- +4 IF '$GET(SDCP)
- SET SDZ=$GET(^TMP("SDNAVA",$JOB,SDIV))
- QUIT
- +5 IF '$GET(SC)
- SET SDZ=$GET(^TMP("SDNAVA",$JOB,SDIV,SDCP))
- QUIT
- +6 IF '$GET(SDT)
- SET SDZ=$GET(^TMP("SDNAVA",$JOB,SDIV,SDCP,SC))
- QUIT
- +7 SET SDZ=$GET(^TMP("SDNAVA",$JOB,SDIV,SDCP,SC,SDT))
- QUIT
- End DoDot:1
- +8 SET SDY=SDY_U_$PIECE(SDZ,U,1,8)_U_$PIECE(SDZ,U,38,39)
- +9 QUIT SDY
- +10 ;
- TRX2() IF '$GET(SDCP)
- SET SDY=$PIECE($GET(^TMP("SDNAVA",$JOB,SDIV)),U,9,20)
- QUIT SDY
- +1 IF '$GET(SC)
- SET SDY=$PIECE($GET(^TMP("SDNAVA",$JOB,SDIV,SDCP)),U,9,20)
- QUIT SDY
- +2 IF '$GET(SDT)
- SET SDY=$PIECE($GET(^TMP("SDNAVA",$JOB,SDIV,SDCP,SC)),U,9,20)
- QUIT SDY
- +3 SET SDY=$PIECE($GET(^TMP("SDNAVA",$JOB,SDIV,SDCP,SC,SDT)),U,9,20)
- +4 QUIT SDY
- +5 ;
- TRX3() IF '$GET(SDCP)
- SET SDY=$PIECE($GET(^TMP("SDNAVA",$JOB,SDIV)),U,21,37)
- QUIT SDY
- +1 IF '$GET(SC)
- SET SDY=$PIECE($GET(^TMP("SDNAVA",$JOB,SDIV,SDCP)),U,21,37)
- QUIT SDY
- +2 IF '$GET(SDT)
- SET SDY=$PIECE($GET(^TMP("SDNAVA",$JOB,SDIV,SDCP,SC)),U,21,37)
- QUIT SDY
- +3 SET SDY=$PIECE($GET(^TMP("SDNAVA",$JOB,SDIV,SDCP,SC,SDT)),U,21,37)
- +4 QUIT SDY
- +5 ;
- DAY(SDI,SDP,SDBDT) ;Produce date/day value
- +1 ;Input: SDI=array subscript incrementor
- +2 ;Input: SDP=$PIECE of string containing related date data
- +3 ;Input: SDBDT=report start date
- +4 NEW X1,X2,X,%H,Y,SDT,SDAY
- +5 SET X1=SDBDT
- SET X2=-1
- DO C^%DTC
- +6 SET X1=X
- SET X2=SDI*12+SDP
- DO C^%DTC
- SET SDT=X
- +7 DO DW^%DTC
- SET SDAY=X
- SET Y=SDT
- XECUTE ^DD("DD")
- +8 QUIT Y_" "_$SELECT($EXTRACT(SDT,6)=0:"-",1:"")_"- "_SDAY_U_SDT
- +9 ;
- SUM(SDIV,SDREPORT) ;Print division/facility summary
- +1 ;Input: SDDIV=division name^number (or '0' for facility total)
- +2 ;Input: SDREPORT=report element to print
- +3 ;
- +4 IF SDREPORT=4!(SDREPORT=5)
- QUIT
- +5 NEW SDY,SCNA,SDI
- +6 SET SDCP=""
- SET SDHD=$SELECT(SDIV=0:3,1:2)
- DO HDR^SCRPW76(SDHD,SDREPORT,SDIV)
- +7 FOR
- SET SDCP=$ORDER(^TMP("SD",$JOB,SDIV,SDCP))
- if SDCP=""!SDOUT
- QUIT
- Begin DoDot:1
- +8 SET SDX=^TMP("SD",$JOB,SDIV,SDCP)
- SET SDY=$GET(^TMP("SD",$JOB,SDIV))
- +9 FOR SDI=1:1:3
- SET $PIECE(SDY,U,SDI)=$PIECE(SDY,U,SDI)+$PIECE(SDX,U,SDI)
- +10 SET ^TMP("SD",$JOB,SDIV)=SDY
- +11 ;Quit if no data
- if '$$DATA(1)
- QUIT
- +12 IF SDMD
- SET SDY=$GET(^TMP("SD",$JOB,0,SDCP))
- Begin DoDot:2
- +13 FOR SDI=1:1:3
- SET $PIECE(SDY,U,SDI)=$PIECE(SDY,U,SDI)+$PIECE(SDX,U,SDI)
- +14 SET ^TMP("SD",$JOB,0,SDCP)=SDY
- End DoDot:2
- +15 SET SDY=$$OTX("CP")
- SET SDX=$$TRX(SDREPORT,SDX,SDIV,SDCP)
- +16 DO OUTPUT(SDREPORT,SDY,SDX,SDCOL,0,1,SDPAST,.SDXM)
- +17 SET SCNA=""
- FOR
- SET SCNA=$ORDER(^TMP("SDS",$JOB,SDCP,SCNA))
- if SCNA=""!SDOUT
- QUIT
- Begin DoDot:2
- +18 SET SC=0
- FOR
- SET SC=$ORDER(^TMP("SDS",$JOB,SDCP,SCNA,SC))
- if 'SC!SDOUT
- QUIT
- Begin DoDot:3
- +19 SET SDX=$GET(^TMP("SD",$JOB,SDIV,SDCP,SC))
- +20 ;Quit if no data
- if '$$DATA(2)
- QUIT
- +21 IF 'SDXM
- IF $Y>(IOSL-SDFLEN)
- Begin DoDot:4
- +22 if SDPAST
- DO FOOTER^SCRPW77(SDREPORT)
- DO HDR^SCRPW76(SDHD,SDREPORT,SDIV)
- +23 QUIT
- End DoDot:4
- +24 if SDOUT
- QUIT
- +25 IF SDMD
- SET SDY=$GET(^TMP("SD",$JOB,0,SDCP,SC))
- Begin DoDot:4
- +26 FOR SDI=1:1:3
- SET $PIECE(SDY,U,SDI)=$PIECE(SDY,U,SDI)+$PIECE(SDX,U,SDI)
- +27 SET ^TMP("SD",$JOB,0,SDCP,SC)=SDY
- +28 QUIT
- End DoDot:4
- +29 SET SDY=$$OTX("CL")
- SET SDX=$$TRX(SDREPORT,SDX,SDIV,SDCP,SC)
- +30 DO OUTPUT(SDREPORT,SDY,SDX,SDCOL,4,0,SDPAST,.SDXM)
- +31 QUIT
- End DoDot:3
- +32 QUIT
- End DoDot:2
- +33 QUIT
- End DoDot:1
- +34 if SDOUT
- QUIT
- SET SDX=$GET(^TMP("SD",$JOB,SDIV))
- SET SDX=$$TRX(SDREPORT,SDX,SDIV)
- +35 IF $GET(SDFMT)="S"&($GET(SDFMTS)="CP")
- if SDPAST
- DO FOOTER^SCRPW77(SDREPORT)
- QUIT
- +36 SET SDY=$SELECT(SDIV=0:"Facility",1:"Division")_" total:"
- DO OUTPUT(SDREPORT,SDY,SDX,SDCOL,0,1,SDPAST,.SDXM,1)
- +37 if SDPAST
- DO FOOTER^SCRPW77(SDREPORT)
- +38 QUIT
- +39 ;
- DATA(SDS) ;Check for data to print
- +1 ;Input: SDS=subscript level
- +2 ;Output: '1' if data, '0' otherwise
- +3 NEW SDCK,SDNODE,SDI,SDCT
- SET (SDCT,SDCK)=0
- +4 if SDFMT'="S"
- QUIT 1
- +5 IF 'SDPAST
- SET SDCK=($PIECE(SDX,U)+$PIECE(SDX,U,2)+$PIECE(SDX,U,3)>0)
- QUIT SDCK
- +6 IF $PIECE(SDX,U)+$PIECE(SDX,U,2)+$PIECE(SDX,U,3)>0
- QUIT 1
- +7 IF SDS=1
- SET SDNODE=$GET(^TMP("SDNAVA",$JOB,SDIV,SDCP))
- +8 IF SDS=2
- SET SDNODE=$GET(^TMP("SDNAVA",$JOB,SDIV,SDCP,SC))
- +9 FOR SDI=1:1:39
- SET SDCT=SDCT+$PIECE(SDNODE,U,SDI)
- +10 SET SDCK=SDCT>0
- +11 QUIT SDCK
- +12 ;
- OUTPUT(SDREPORT,SDTX,SDX,SDCOL,SDC,SDL,SDPAST,SDXM,SDTL) ;Write output or load summary message
- +1 ;Input: SDREPORT=report element to print
- +2 ;Input: SDTX=category text value
- +3 ;Input: SDX=output count values
- +4 ;Input: SDCOL=margin adjusted column control
- +5 ;Input: SDC=column to start line
- +6 ;Input: SDL=number of additional linefeeds
- +7 ;Input: SDPAST='0' if dates > TODAY, '1' otherwise
- +8 ;Input: SDXM=mail message line number message text (optional)
- +9 ;Input: SDTL='1' if this is a totals line
- +10 ;
- +11 NEW SDI,SDPCT
- +12 if $GET(SDXM)
- GOTO OUTXM
- FOR SDI=1:1:SDL
- WRITE !
- +13 if SDREPORT=1
- DO OUT1
- if SDREPORT=2
- DO OUT2
- if SDREPORT=3
- DO OUT3
- +14 QUIT
- +15 ;
- OUT1 NEW SDL1,SDL2,SDL3
- +1 WRITE !?(SDCOL+SDC),SDTX
- +2 FOR SDI=1:1:$SELECT(SDPAST:12,1:3)
- DO MANI(SDX,SDI,$GET(SDTL))
- Begin DoDot:1
- +3 WRITE ?(SDCOL+34+SDL1+(SDI-1*7)),$JUSTIFY(+$PIECE(SDX,U,SDI),$SELECT(((SDI<3)&(SDL3>7)):SDL3,SDI=3:(6-SDL1),1:7),$$OPD())_$SELECT(SDI=3:"%",1:"")
- +4 QUIT
- End DoDot:1
- +5 IF SDPAST
- FOR SDI=0,1
- Begin DoDot:1
- +6 WRITE ?(SDCOL+118+(SDI*7)),$JUSTIFY(+$PIECE(SDX,U,13+SDI),6,0)_"%"
- +7 QUIT
- End DoDot:1
- +8 QUIT
- +9 ;
- MANI(SDX,SDI,SDTL) ;Manipulate column position for large totals
- +1 ;
- +2 SET (SDL1,SDL2)=0
- SET SDL3=$LENGTH($PIECE(SDX,U,SDI))
- +3 IF $GET(SDTL)
- Begin DoDot:1
- +4 IF SDI=1
- IF SDL3>7
- SET SDL1=(7-SDL3)
- +5 IF SDI=2
- IF SDL3>6
- SET SDL1=1
- +6 IF SDI=3
- SET SDL1=3
- +7 QUIT
- End DoDot:1
- +8 QUIT
- +9 ;
- OUT2 WRITE !?(SDCOL+SDC),SDTX
- +1 FOR SDI=0:1:5
- Begin DoDot:1
- +2 WRITE ?(36+(SDI*16)),$JUSTIFY(+$PIECE(SDX,U,(1+(SDI*2))),8,0)
- +3 WRITE ?(44+(SDI*16)),$JUSTIFY(+$PIECE(SDX,U,(2+(SDI*2))),8,1)
- +4 QUIT
- End DoDot:1
- +5 QUIT
- +6 ;
- OUT3 WRITE !?(SDCOL+SDC),SDTX
- +1 WRITE ?30,$JUSTIFY(+$PIECE(SDX,U),6,0),?36,$JUSTIFY(+$PIECE(SDX,U,2),6,1)
- +2 FOR SDI=0:1:4
- Begin DoDot:1
- +3 WRITE ?(42+(SDI*18)),$JUSTIFY(+$PIECE(SDX,U,(3+(SDI*3))),6,0)
- +4 WRITE ?(48+(SDI*18)),$JUSTIFY(+$PIECE(SDX,U,(4+(SDI*3))),6,1)
- +5 WRITE ?(54+(SDI*18)),$JUSTIFY(+$PIECE(SDX,U,(5+(SDI*3))),6,1)
- +6 QUIT
- End DoDot:1
- +7 QUIT
- +8 ;
- OPD() ;Output decimal places
- +1 QUIT $SELECT(SDI<6:0,SDI#2:0,1:1)
- +2 ;
- OUTXM ;Load bulletin message text
- +1 ;Output: ^TMP("SDXM",$J,SDXM)=mail message text line
- +2 NEW SDZ
- if SDC<1
- SET SDC=1
- +3 FOR SDI=1:1:SDL
- DO XMTX("")
- +4 if SDREPORT=1
- DO OUTXM1
- if SDREPORT=2
- DO OUTXM2
- if SDREPORT=3
- DO OUTXM3
- +5 QUIT
- +6 ;
- OUTXM1 NEW SDL1,SDL2,SDL3
- +1 SET SDZ=""
- SET $EXTRACT(SDZ,SDC)=SDTX
- +2 FOR SDI=1:1:$SELECT(SDPAST:12,1:3)
- DO MANI(SDX,SDI,$GET(SDTL))
- Begin DoDot:1
- +3 SET $EXTRACT(SDZ,(35+SDL1+(SDI-1*7)))=$JUSTIFY(+$PIECE(SDX,U,SDI),$SELECT(((SDI<3)&(SDL3>7)):SDL3,SDI=3:(6-SDL1),1:7),$$OPD())_$SELECT(SDI=3:"%",1:"")
- End DoDot:1
- +4 IF SDPAST
- FOR SDI=0,1
- Begin DoDot:1
- +5 SET $EXTRACT(SDZ,(119+(SDI*7)))=$JUSTIFY(+$PIECE(SDX,U,13+SDI),6,0)_"%"
- End DoDot:1
- +6 DO XMTX(SDZ)
- +7 QUIT
- +8 ;
- OUTXM2 SET SDZ=""
- SET $EXTRACT(SDZ,SDC)=SDTX
- +1 FOR SDI=0:1:5
- Begin DoDot:1
- +2 SET $EXTRACT(SDZ,(37+(SDI*16)))=$JUSTIFY(+$PIECE(SDX,U,(1+(SDI*2))),8,0)
- +3 SET $EXTRACT(SDZ,(45+(SDI*16)))=$JUSTIFY(+$PIECE(SDX,U,(2+(SDI*2))),8,1)
- +4 QUIT
- End DoDot:1
- +5 DO XMTX(SDZ)
- +6 QUIT
- +7 ;
- OUTXM3 SET SDZ=""
- SET $EXTRACT(SDZ,SDC)=SDTX
- +1 SET $EXTRACT(SDZ,31)=$JUSTIFY(+$PIECE(SDX,U),6,0)
- SET $EXTRACT(SDZ,37)=$JUSTIFY(+$PIECE(SDX,U,2),6,1)
- +2 FOR SDI=0:1:4
- Begin DoDot:1
- +3 SET $EXTRACT(SDZ,(43+(SDI*18)))=$JUSTIFY(+$PIECE(SDX,U,(3+(SDI*3))),6,0)
- +4 SET $EXTRACT(SDZ,(49+(SDI*18)))=$JUSTIFY(+$PIECE(SDX,U,(4+(SDI*3))),6,1)
- +5 SET $EXTRACT(SDZ,(55+(SDI*18)))=$JUSTIFY(+$PIECE(SDX,U,(5+(SDI*3))),6,1)
- +6 QUIT
- End DoDot:1
- +7 DO XMTX(SDZ)
- +8 QUIT
- +9 ;
- XMTX(SDX) ;Set mail message text line
- +1 ;Input: SDX=text value
- +2 SET ^TMP("SDXM",$JOB,SDXM)=SDX
- SET SDXM=SDXM+1
- QUIT
- +3 ;
- OTX(SDSORT) ;Produce output text for clinic or credit pair
- +1 ;Input: SDSORT='CL' for clinic name, 'CP' for credit pair
- +2 NEW SDZ,SDSC1,SDSC2
- +3 IF SDSORT="CL"
- Begin DoDot:1
- +4 SET SDZ=$PIECE($GET(^SC(+SC,0)),U)
- if '$LENGTH(SDZ)
- SET SDZ="UNKNOWN"
- +5 IF SDREPORT=3
- SET SDZ=$EXTRACT(SDZ,1,26)
- +6 QUIT
- End DoDot:1
- QUIT SDZ
- +7 SET SDSC1=$ORDER(^DIC(40.7,"C",$EXTRACT(SDCP,1,3),""))
- +8 SET SDSC1=$PIECE($GET(^DIC(40.7,+SDSC1,0)),U)
- SET SDSC1=$TRANSLATE(SDSC1,"/","-")
- +9 if '$LENGTH(SDSC1)
- SET SDSC1="UNKNOWN"
- +10 IF $EXTRACT(SDCP,4,6)="000"
- SET SDSC2="(NONE)"
- GOTO CPO1
- +11 SET SDSC2=$ORDER(^DIC(40.7,"C",$EXTRACT(SDCP,4,6),""))
- +12 SET SDSC2=$PIECE($GET(^DIC(40.7,+SDSC2,0)),U)
- SET SDSC2=$TRANSLATE(SDSC2,"/","-")
- +13 if '$LENGTH(SDSC2)
- SET SDSC2="UNKNOWN"
- CPO1 IF $LENGTH(SDSC1)<13
- SET SDZ=SDSC1_"/"_$EXTRACT(SDSC2,1,(13+(13-$LENGTH(SDSC1))))
- GOTO CPOTQ
- +1 IF $LENGTH(SDSC2)<13
- SET SDZ=$EXTRACT(SDSC1,1,(13+(13-$LENGTH(SDSC2))))_"/"_SDSC2
- GOTO CPOTQ
- +2 SET SDZ=$EXTRACT(SDSC1,1,13)_"/"_$EXTRACT(SDSC2,1,13)
- CPOTQ SET SDZ=SDCP_" "_SDZ
- IF SDREPORT=3
- SET SDZ=$EXTRACT(SDZ,1,30)
- +1 QUIT SDZ