DGPMTSR1 ;ALB/LM - TREATING SPECIALTY REPORT VARIABLES ; 3/1/93
;;5.3;Registration;;Aug 13, 1993
;
A ; This will set up variables used in ^TMP
Q
;
START S TS=$O(^DG(40.8,"ATS",D,ORDER,0)) ; Treating Specialty
S S=$P(^DIC(45.7,TS,0),"^",2) ; Pointer to Specialty File
S S=$P(^DIC(42.4,S,0),"^",3) ; Service Set of Codes
S SV=$S(S="M":"MEDICINE",S="S":"SURGERY",S="P":"PSYCHIATRY",S="NH":"NHCU",S="NE":"NEUROLOGY",S="I":"INTERMEDIATE MED",S="R":"REHAB MEDICINE",S="SCI":"SPINAL CORD INJURY",S="D":"DOMICILIARY",S="B":"BLIND REHAB",S="RE":"RESPITE CARE",1:"")
;
TOTALS I '$D(^TMP("TSRG",$J)) S ^TMP("TSRG",$J)="GRAND TOTAL",BD("G")=0
I '$D(^TMP("TSRD",$J,D)) S ^TMP("TSRD",$J,D)=$P(^DG(40.8,D,0),"^")_" TOTALS" S BD("D")=0 ; Division Name
I '$D(^TMP("TSRS",$J,D,S)) S ^TMP("TSRS",$J,D,S)=SV_" TOTALS" S BD("S")=0 ; Service Name
S ^TMP("TSR",$J,D,S,ORDER,TS)=$P(^DIC(45.7,TS,0),"^") ; Treating Specialty Name
;
NODES S CN=$S($D(^DG(40.8,D,"TS",TS,"C",RD,0)):^(0),1:"") ; TS Census 0 Node
S CN(1)=$S($D(^DG(40.8,D,"TS",TS,"C",RD,1)):^(1),1:"") ; TS Census 1 Node
S CN1=$S($D(^DG(40.8,D,"TS",TS,"C",PD,0)):^(0),1:"") ; TS Census 0 Node (Previous Date)
;
S:$E(PD,4,7)="0930" CN1="^"_$P(CN1,"^",2) ; NO cumulative totals if beginning of FY
I RD=TSRI S CN1="^"_$S($D(^DG(40.8,D,"TS",TS,0)):$P(^DG(40.8,D,"TS",TS,0),"^",3),1:0) ; Utilize whats in beginning TSR Patients on TSR Initialization Date
;
S X2=$S(+$E(RD,4,5)<10:+$E(RD,1,3)-1,1:$E(RD,1,3))_"0930" ; Place holder for FY
S X1=RD D ^%DTC S FY("D")=+X ; Total Elapsed Fiscal Days
;
DAYS ; Cum Pat Days of Care (new)
S BD("P")=$P(CN,"^",3)
S BD("S")=($P(^TMP("TSRS",$J,D,S),"^",12))+($P(CN,"^",3))
S BD("D")=($P(^TMP("TSRD",$J,D),"^",12))+($P(CN,"^",3))
S BD("G")=($P(^TMP("TSRG",$J),"^",12))+($P(CN,"^",3))
;
ADC ; Cum Ave Daily Census
S ADC("P")=$J((BD("P")/FY("D")),0,1)
S ADC("S")=$J((BD("S")/FY("D")),0,1)
S ADC("D")=$J((BD("D")/FY("D")),0,1)
S ADC("G")=$J((BD("G")/FY("D")),0,1)
END Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMTSR1 2013 printed Sep 23, 2025@20:25:54 Page 2
DGPMTSR1 ;ALB/LM - TREATING SPECIALTY REPORT VARIABLES ; 3/1/93
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;
A ; This will set up variables used in ^TMP
+1 QUIT
+2 ;
START ; Treating Specialty
SET TS=$ORDER(^DG(40.8,"ATS",D,ORDER,0))
+1 ; Pointer to Specialty File
SET S=$PIECE(^DIC(45.7,TS,0),"^",2)
+2 ; Service Set of Codes
SET S=$PIECE(^DIC(42.4,S,0),"^",3)
+3 SET SV=$SELECT(S="M":"MEDICINE",S="S":"SURGERY",S="P":"PSYCHIATRY",S="NH":"NHCU",S="NE":"NEUROLOGY",S="I":"INTERMEDIATE MED",S="R":"REHAB MEDICINE",S="SCI":"SPINAL CORD INJURY",S="D":"DOMICILIARY",S="B":"BLIND REHAB",S="RE":"RESPITE CARE",1:"")
+4 ;
TOTALS IF '$DATA(^TMP("TSRG",$JOB))
SET ^TMP("TSRG",$JOB)="GRAND TOTAL"
SET BD("G")=0
+1 ; Division Name
IF '$DATA(^TMP("TSRD",$JOB,D))
SET ^TMP("TSRD",$JOB,D)=$PIECE(^DG(40.8,D,0),"^")_" TOTALS"
SET BD("D")=0
+2 ; Service Name
IF '$DATA(^TMP("TSRS",$JOB,D,S))
SET ^TMP("TSRS",$JOB,D,S)=SV_" TOTALS"
SET BD("S")=0
+3 ; Treating Specialty Name
SET ^TMP("TSR",$JOB,D,S,ORDER,TS)=$PIECE(^DIC(45.7,TS,0),"^")
+4 ;
NODES ; TS Census 0 Node
SET CN=$SELECT($DATA(^DG(40.8,D,"TS",TS,"C",RD,0)):^(0),1:"")
+1 ; TS Census 1 Node
SET CN(1)=$SELECT($DATA(^DG(40.8,D,"TS",TS,"C",RD,1)):^(1),1:"")
+2 ; TS Census 0 Node (Previous Date)
SET CN1=$SELECT($DATA(^DG(40.8,D,"TS",TS,"C",PD,0)):^(0),1:"")
+3 ;
+4 ; NO cumulative totals if beginning of FY
if $EXTRACT(PD,4,7)="0930"
SET CN1="^"_$PIECE(CN1,"^",2)
+5 ; Utilize whats in beginning TSR Patients on TSR Initialization Date
IF RD=TSRI
SET CN1="^"_$SELECT($DATA(^DG(40.8,D,"TS",TS,0)):$PIECE(^DG(40.8,D,"TS",TS,0),"^",3),1:0)
+6 ;
+7 ; Place holder for FY
SET X2=$SELECT(+$EXTRACT(RD,4,5)<10:+$EXTRACT(RD,1,3)-1,1:$EXTRACT(RD,1,3))_"0930"
+8 ; Total Elapsed Fiscal Days
SET X1=RD
DO ^%DTC
SET FY("D")=+X
+9 ;
DAYS ; Cum Pat Days of Care (new)
+1 SET BD("P")=$PIECE(CN,"^",3)
+2 SET BD("S")=($PIECE(^TMP("TSRS",$JOB,D,S),"^",12))+($PIECE(CN,"^",3))
+3 SET BD("D")=($PIECE(^TMP("TSRD",$JOB,D),"^",12))+($PIECE(CN,"^",3))
+4 SET BD("G")=($PIECE(^TMP("TSRG",$JOB),"^",12))+($PIECE(CN,"^",3))
+5 ;
ADC ; Cum Ave Daily Census
+1 SET ADC("P")=$JUSTIFY((BD("P")/FY("D")),0,1)
+2 SET ADC("S")=$JUSTIFY((BD("S")/FY("D")),0,1)
+3 SET ADC("D")=$JUSTIFY((BD("D")/FY("D")),0,1)
+4 SET ADC("G")=$JUSTIFY((BD("G")/FY("D")),0,1)
END QUIT
