- 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 Jan 18, 2025@03:50:43 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