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

DGPMTSR.m

Go to the documentation of this file.
  1. DGPMTSR ;ALB/LM - TREATING SPECIALTY REPORT PRINT ; 3/12/93
  1. ;;5.3;Registration;**34,134**;Aug 13, 1993
  1. ;
  1. A ; This will output ^TMP totals by treating specialty ; by service ; by division ; and finally by grand total
  1. ;
  1. START ;
  1. K ^TMP("TSR",$J),^TMP("TSRS",$J),^TMP("TSRD",$J),^TMP("TSRG",$J) ; cleans out temp global.
  1. I '$D(^DG(40.8,"ATS")) G END
  1. I TSRI>RD Q ; If report date is not greater than TSR Initialization date quit
  1. ;
  1. S PAGE=0
  1. S D=0 F D1=0:0 S D=$O(^DG(40.8,"ATS",D)) Q:'D S ORDER=0 F O1=0:0 S ORDER=$O(^DG(40.8,"ATS",D,ORDER)) Q:ORDER="" F I=0:0 S I=$O(^DG(40.8,"ATS",D,ORDER,I)) Q:'I I ORDER>0 D START^DGPMTSR1,START^DGPMTSR2
  1. ;
  1. D HEAD I $D(END) Q
  1. D PRINT
  1. D KILL
  1. ;
  1. END Q
  1. ;
  1. W:'($E(IOST,1,2)'="C-"&'$D(PAGE)) @IOF
  1. S PAGE=PAGE+1
  1. W !?94,"Date/Time Printed: ",DGNOW
  1. W !?RM-26\2,"TREATING SPECIALTY REPORT"
  1. W ?(IOM-10),"PAGE ",$J(PAGE,3)
  1. S X=$$NAME^VASITE(RD)
  1. I X']"" D
  1. .S X="VA MEDICAL CENTER"
  1. .S DGPM("GL")=$S($D(^DG(43,1,"GL")):^("GL"),1:"")
  1. .S:$D(^DG(40.8,+$P(DGPM("GL"),"^",3),0)) X=X_", "_$P(^(0),"^")
  1. W !?RM-$L(X)\2,X
  1. S X=RD
  1. D DW^%DTC
  1. S X1=X,X="PERIOD ENDING MIDNIGHT "_X1_", "
  1. S Y=RD X ^DD("DD") S X=X_Y
  1. W !?RM-$L(X)\2,X,!
  1. S X="T O T A L S B Y T R E A T I N G S P E C I A L T Y"
  1. ;
  1. W ! W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
  1. W !?0,"|",?(RM-$L(X)\2),X,?130,"|"
  1. W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
  1. ;
  1. HEAD2 W !?0,"|","DIVISION",?44,"PREVIOUS",?74,"CURRENT",?109,"AVERAGE",?118,"CUMULATIVE",?130,"|"
  1. W !?0,"|",?2,"SERVICE",?44,"PATIENTS",?74,"PATIENT",?109,"DAILY",?118,"PATIENT",?130,"|"
  1. W !?0,"|",?3,"FACILITY TREATING SPECIALTY",?44,"REMAINING",?57,"GAINS",?65,"LOSSES",?74,"REMAINING",?86,"PASS",?93,"AA",?98,"UA",?103,"ASIH",?109,"CENSUS",?118,"DAYS OF CARE",?130,"|"
  1. W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
  1. Q
  1. ;
  1. PRINT ; Output
  1. S TAB="3^44^57^65^74^86^93^98^103^109^118"
  1. S JUS="1^5^3^4^5^3^2^2^3^6^7"
  1. ;
  1. F D=0:0 S D=$O(^TMP("TSR",$J,D)) Q:'D!$D(END) S DIVISION=D W !?1,$P(^TMP("TSRD",$J,D)," TOTALS") D S Q:$D(END) D TSRD Q:$D(END)
  1. I $D(END) Q
  1. D TSRG
  1. PEND Q ; print end
  1. ;
  1. S S S="" F S1=0:0 S S=$O(^TMP("TSR",$J,D,S)) Q:S="" S SERVICE=S W !?2,$P(^TMP("TSRS",$J,D,S)," TOTALS") D ORDER Q:$D(END) D TSRS Q:$D(END)
  1. Q
  1. ;
  1. ORDER S ORDER=0 F ORDER1=0:0 S ORDER=$O(^TMP("TSR",$J,D,S,ORDER)) Q:'ORDER D TS Q:$D(END)
  1. Q
  1. TS F TS=0:0 S TS=$O(^TMP("TSR",$J,D,S,ORDER,TS)) Q:'TS D TSR Q:$D(END)
  1. Q
  1. ;
  1. TSR ; print treating specialty total
  1. I $Y+5>IOSL D HEAD Q:$D(END)
  1. W !
  1. F I=1:1:11 W ?+$P(TAB,"^",I),$J($P(^TMP("TSR",$J,D,S,ORDER,TS),"^",I),$P(JUS,"^",I))
  1. Q
  1. ;
  1. TSRS ; print service total
  1. I $Y+7>IOSL D HEAD Q:$D(END)
  1. W !
  1. F L=1:1:(IOM-3) W "-"
  1. W !
  1. F I=1:1:11 W ?+$P(TAB,"^",I),$J($P(^TMP("TSRS",$J,D,SERVICE),"^",I),$P(JUS,"^",I))
  1. W !
  1. F L=1:1:(IOM-3) W "-"
  1. Q
  1. ;
  1. TSRD ; print division total
  1. I $Y+6>IOSL D HEAD Q:$D(END)
  1. W !
  1. F I=1:1:11 W ?+$P(TAB,"^",I),$J($P(^TMP("TSRD",$J,DIVISION),"^",I),$P(JUS,"^",I))
  1. W !
  1. F L=1:1:(IOM-3) W "-"
  1. Q
  1. ;
  1. TSRG ; print grand total
  1. I $Y+6>IOSL D HEAD Q:$D(END)
  1. W !
  1. F I=1:1:11 W ?+$P(TAB,"^",I),$J($P(^TMP("TSRG",$J),"^",I),$P(JUS,"^",I))
  1. W !
  1. F L=1:1:(IOM-3) W "-"
  1. Q
  1. ;
  1. KILL ; Kills Variables
  1. K ^TMP("TSR",$J),^TMP("TSRS",$J),^TMP("TSRD",$J),^TMP("TSRG",$J)
  1. K ADC,BD,CN,D,D,D1,DIVISION,DGPM("GL"),FY("D"),I,JUS,L,ORDER,ORDER1,O1,PD,RD,RM,S,SERVICE,S,S1,T,TAB,TS,UL,X,X,X1,X2,Y,TSR,DGNOW,END,PAGE,SV,TSRI
  1. Q