DGPMTSR ;ALB/LM - TREATING SPECIALTY REPORT PRINT ; 3/12/93
;;5.3;Registration;**34,134**;Aug 13, 1993
;
A ; This will output ^TMP totals by treating specialty ; by service ; by division ; and finally by grand total
;
START ;
K ^TMP("TSR",$J),^TMP("TSRS",$J),^TMP("TSRD",$J),^TMP("TSRG",$J) ; cleans out temp global.
I '$D(^DG(40.8,"ATS")) G END
I TSRI>RD Q ; If report date is not greater than TSR Initialization date quit
;
S PAGE=0
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
;
D HEAD I $D(END) Q
D PRINT
D KILL
;
END Q
;
HEAD I PAGE,$E(IOST,1,2)="C-" W !,"Press RETURN to continue or '^' to exit: " R X:DTIME S:X='$T!(X="^") END=1 Q:$D(END)
W:'($E(IOST,1,2)'="C-"&'$D(PAGE)) @IOF
S PAGE=PAGE+1
W !?94,"Date/Time Printed: ",DGNOW
W !?RM-26\2,"TREATING SPECIALTY REPORT"
W ?(IOM-10),"PAGE ",$J(PAGE,3)
S X=$$NAME^VASITE(RD)
I X']"" D
.S X="VA MEDICAL CENTER"
.S DGPM("GL")=$S($D(^DG(43,1,"GL")):^("GL"),1:"")
.S:$D(^DG(40.8,+$P(DGPM("GL"),"^",3),0)) X=X_", "_$P(^(0),"^")
W !?RM-$L(X)\2,X
S X=RD
D DW^%DTC
S X1=X,X="PERIOD ENDING MIDNIGHT "_X1_", "
S Y=RD X ^DD("DD") S X=X_Y
W !?RM-$L(X)\2,X,!
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"
;
W ! W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
W !?0,"|",?(RM-$L(X)\2),X,?130,"|"
W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
;
HEAD2 W !?0,"|","DIVISION",?44,"PREVIOUS",?74,"CURRENT",?109,"AVERAGE",?118,"CUMULATIVE",?130,"|"
W !?0,"|",?2,"SERVICE",?44,"PATIENTS",?74,"PATIENT",?109,"DAILY",?118,"PATIENT",?130,"|"
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,"|"
W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
Q
;
PRINT ; Output
S TAB="3^44^57^65^74^86^93^98^103^109^118"
S JUS="1^5^3^4^5^3^2^2^3^6^7"
;
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)
I $D(END) Q
D TSRG
PEND Q ; print end
;
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)
Q
;
ORDER S ORDER=0 F ORDER1=0:0 S ORDER=$O(^TMP("TSR",$J,D,S,ORDER)) Q:'ORDER D TS Q:$D(END)
Q
TS F TS=0:0 S TS=$O(^TMP("TSR",$J,D,S,ORDER,TS)) Q:'TS D TSR Q:$D(END)
Q
;
TSR ; print treating specialty total
I $Y+5>IOSL D HEAD Q:$D(END)
W !
F I=1:1:11 W ?+$P(TAB,"^",I),$J($P(^TMP("TSR",$J,D,S,ORDER,TS),"^",I),$P(JUS,"^",I))
Q
;
TSRS ; print service total
I $Y+7>IOSL D HEAD Q:$D(END)
W !
F L=1:1:(IOM-3) W "-"
W !
F I=1:1:11 W ?+$P(TAB,"^",I),$J($P(^TMP("TSRS",$J,D,SERVICE),"^",I),$P(JUS,"^",I))
W !
F L=1:1:(IOM-3) W "-"
Q
;
TSRD ; print division total
I $Y+6>IOSL D HEAD Q:$D(END)
W !
F I=1:1:11 W ?+$P(TAB,"^",I),$J($P(^TMP("TSRD",$J,DIVISION),"^",I),$P(JUS,"^",I))
W !
F L=1:1:(IOM-3) W "-"
Q
;
TSRG ; print grand total
I $Y+6>IOSL D HEAD Q:$D(END)
W !
F I=1:1:11 W ?+$P(TAB,"^",I),$J($P(^TMP("TSRG",$J),"^",I),$P(JUS,"^",I))
W !
F L=1:1:(IOM-3) W "-"
Q
;
KILL ; Kills Variables
K ^TMP("TSR",$J),^TMP("TSRS",$J),^TMP("TSRD",$J),^TMP("TSRG",$J)
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMTSR 3591 printed Sep 23, 2025@20:25:53 Page 2
DGPMTSR ;ALB/LM - TREATING SPECIALTY REPORT PRINT ; 3/12/93
+1 ;;5.3;Registration;**34,134**;Aug 13, 1993
+2 ;
A ; This will output ^TMP totals by treating specialty ; by service ; by division ; and finally by grand total
+1 ;
START ;
+1 ; cleans out temp global.
KILL ^TMP("TSR",$JOB),^TMP("TSRS",$JOB),^TMP("TSRD",$JOB),^TMP("TSRG",$JOB)
+2 IF '$DATA(^DG(40.8,"ATS"))
GOTO END
+3 ; If report date is not greater than TSR Initialization date quit
IF TSRI>RD
QUIT
+4 ;
+5 SET PAGE=0
+6 SET D=0
FOR D1=0:0
SET D=$ORDER(^DG(40.8,"ATS",D))
if 'D
QUIT
SET ORDER=0
FOR O1=0:0
SET ORDER=$ORDER(^DG(40.8,"ATS",D,ORDER))
if ORDER=""
QUIT
FOR I=0:0
SET I=$ORDER(^DG(40.8,"ATS",D,ORDER,I))
if 'I
QUIT
IF ORDER>0
DO START^DGPMTSR1
DO START^DGPMTSR2
+7 ;
+8 DO HEAD
IF $DATA(END)
QUIT
+9 DO PRINT
+10 DO KILL
+11 ;
END QUIT
+1 ;
HEAD IF PAGE
IF $EXTRACT(IOST,1,2)="C-"
WRITE !,"Press RETURN to continue or '^' to exit: "
READ X:DTIME
if X='$TEST!(X="^")
SET END=1
if $DATA(END)
QUIT
+1 if '($EXTRACT(IOST,1,2)'="C-"&'$DATA(PAGE))
WRITE @IOF
+2 SET PAGE=PAGE+1
+3 WRITE !?94,"Date/Time Printed: ",DGNOW
+4 WRITE !?RM-26\2,"TREATING SPECIALTY REPORT"
+5 WRITE ?(IOM-10),"PAGE ",$JUSTIFY(PAGE,3)
+6 SET X=$$NAME^VASITE(RD)
+7 IF X']""
Begin DoDot:1
+8 SET X="VA MEDICAL CENTER"
+9 SET DGPM("GL")=$SELECT($DATA(^DG(43,1,"GL")):^("GL"),1:"")
+10 if $DATA(^DG(40.8,+$PIECE(DGPM("GL"),"^",3),0))
SET X=X_", "_$PIECE(^(0),"^")
End DoDot:1
+11 WRITE !?RM-$LENGTH(X)\2,X
+12 SET X=RD
+13 DO DW^%DTC
+14 SET X1=X
SET X="PERIOD ENDING MIDNIGHT "_X1_", "
+15 SET Y=RD
XECUTE ^DD("DD")
SET X=X_Y
+16 WRITE !?RM-$LENGTH(X)\2,X,!
+17 SET 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"
+18 ;
+19 WRITE !
if $Y<131
WRITE ?131,""
WRITE $CHAR(13)
if UL["-"
WRITE !
FOR L=1:1:131
WRITE UL
+20 WRITE !?0,"|",?(RM-$LENGTH(X)\2),X,?130,"|"
+21 if $Y<131
WRITE ?131,""
WRITE $CHAR(13)
if UL["-"
WRITE !
FOR L=1:1:131
WRITE UL
+22 ;
HEAD2 WRITE !?0,"|","DIVISION",?44,"PREVIOUS",?74,"CURRENT",?109,"AVERAGE",?118,"CUMULATIVE",?130,"|"
+1 WRITE !?0,"|",?2,"SERVICE",?44,"PATIENTS",?74,"PATIENT",?109,"DAILY",?118,"PATIENT",?130,"|"
+2 WRITE !?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,"|"
+3 if $Y<131
WRITE ?131,""
WRITE $CHAR(13)
if UL["-"
WRITE !
FOR L=1:1:131
WRITE UL
+4 QUIT
+5 ;
PRINT ; Output
+1 SET TAB="3^44^57^65^74^86^93^98^103^109^118"
+2 SET JUS="1^5^3^4^5^3^2^2^3^6^7"
+3 ;
+4 FOR D=0:0
SET D=$ORDER(^TMP("TSR",$JOB,D))
if 'D!$DATA(END)
QUIT
SET DIVISION=D
WRITE !?1,$PIECE(^TMP("TSRD",$JOB,D)," TOTALS")
DO S
if $DATA(END)
QUIT
DO TSRD
if $DATA(END)
QUIT
+5 IF $DATA(END)
QUIT
+6 DO TSRG
PEND ; print end
QUIT
+1 ;
S SET S=""
FOR S1=0:0
SET S=$ORDER(^TMP("TSR",$JOB,D,S))
if S=""
QUIT
SET SERVICE=S
WRITE !?2,$PIECE(^TMP("TSRS",$JOB,D,S)," TOTALS")
DO ORDER
if $DATA(END)
QUIT
DO TSRS
if $DATA(END)
QUIT
+1 QUIT
+2 ;
ORDER SET ORDER=0
FOR ORDER1=0:0
SET ORDER=$ORDER(^TMP("TSR",$JOB,D,S,ORDER))
if 'ORDER
QUIT
DO TS
if $DATA(END)
QUIT
+1 QUIT
TS FOR TS=0:0
SET TS=$ORDER(^TMP("TSR",$JOB,D,S,ORDER,TS))
if 'TS
QUIT
DO TSR
if $DATA(END)
QUIT
+1 QUIT
+2 ;
TSR ; print treating specialty total
+1 IF $Y+5>IOSL
DO HEAD
if $DATA(END)
QUIT
+2 WRITE !
+3 FOR I=1:1:11
WRITE ?+$PIECE(TAB,"^",I),$JUSTIFY($PIECE(^TMP("TSR",$JOB,D,S,ORDER,TS),"^",I),$PIECE(JUS,"^",I))
+4 QUIT
+5 ;
TSRS ; print service total
+1 IF $Y+7>IOSL
DO HEAD
if $DATA(END)
QUIT
+2 WRITE !
+3 FOR L=1:1:(IOM-3)
WRITE "-"
+4 WRITE !
+5 FOR I=1:1:11
WRITE ?+$PIECE(TAB,"^",I),$JUSTIFY($PIECE(^TMP("TSRS",$JOB,D,SERVICE),"^",I),$PIECE(JUS,"^",I))
+6 WRITE !
+7 FOR L=1:1:(IOM-3)
WRITE "-"
+8 QUIT
+9 ;
TSRD ; print division total
+1 IF $Y+6>IOSL
DO HEAD
if $DATA(END)
QUIT
+2 WRITE !
+3 FOR I=1:1:11
WRITE ?+$PIECE(TAB,"^",I),$JUSTIFY($PIECE(^TMP("TSRD",$JOB,DIVISION),"^",I),$PIECE(JUS,"^",I))
+4 WRITE !
+5 FOR L=1:1:(IOM-3)
WRITE "-"
+6 QUIT
+7 ;
TSRG ; print grand total
+1 IF $Y+6>IOSL
DO HEAD
if $DATA(END)
QUIT
+2 WRITE !
+3 FOR I=1:1:11
WRITE ?+$PIECE(TAB,"^",I),$JUSTIFY($PIECE(^TMP("TSRG",$JOB),"^",I),$PIECE(JUS,"^",I))
+4 WRITE !
+5 FOR L=1:1:(IOM-3)
WRITE "-"
+6 QUIT
+7 ;
KILL ; Kills Variables
+1 KILL ^TMP("TSR",$JOB),^TMP("TSRS",$JOB),^TMP("TSRD",$JOB),^TMP("TSRG",$JOB)
+2 KILL 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
+3 QUIT
