source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPMTSR1.m@ 1093

Last change on this file since 1093 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1DGPMTSR1 ;ALB/LM - TREATING SPECIALTY REPORT VARIABLES ; 3/1/93
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4A ; This will set up variables used in ^TMP
5 Q
6 ;
7START S TS=$O(^DG(40.8,"ATS",D,ORDER,0)) ; Treating Specialty
8 S S=$P(^DIC(45.7,TS,0),"^",2) ; Pointer to Specialty File
9 S S=$P(^DIC(42.4,S,0),"^",3) ; Service Set of Codes
10 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:"")
11 ;
12TOTALS I '$D(^TMP("TSRG",$J)) S ^TMP("TSRG",$J)="GRAND TOTAL",BD("G")=0
13 I '$D(^TMP("TSRD",$J,D)) S ^TMP("TSRD",$J,D)=$P(^DG(40.8,D,0),"^")_" TOTALS" S BD("D")=0 ; Division Name
14 I '$D(^TMP("TSRS",$J,D,S)) S ^TMP("TSRS",$J,D,S)=SV_" TOTALS" S BD("S")=0 ; Service Name
15 S ^TMP("TSR",$J,D,S,ORDER,TS)=$P(^DIC(45.7,TS,0),"^") ; Treating Specialty Name
16 ;
17NODES S CN=$S($D(^DG(40.8,D,"TS",TS,"C",RD,0)):^(0),1:"") ; TS Census 0 Node
18 S CN(1)=$S($D(^DG(40.8,D,"TS",TS,"C",RD,1)):^(1),1:"") ; TS Census 1 Node
19 S CN1=$S($D(^DG(40.8,D,"TS",TS,"C",PD,0)):^(0),1:"") ; TS Census 0 Node (Previous Date)
20 ;
21 S:$E(PD,4,7)="0930" CN1="^"_$P(CN1,"^",2) ; NO cumulative totals if beginning of FY
22 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
23 ;
24 S X2=$S(+$E(RD,4,5)<10:+$E(RD,1,3)-1,1:$E(RD,1,3))_"0930" ; Place holder for FY
25 S X1=RD D ^%DTC S FY("D")=+X ; Total Elapsed Fiscal Days
26 ;
27DAYS ; Cum Pat Days of Care (new)
28 S BD("P")=$P(CN,"^",3)
29 S BD("S")=($P(^TMP("TSRS",$J,D,S),"^",12))+($P(CN,"^",3))
30 S BD("D")=($P(^TMP("TSRD",$J,D),"^",12))+($P(CN,"^",3))
31 S BD("G")=($P(^TMP("TSRG",$J),"^",12))+($P(CN,"^",3))
32 ;
33ADC ; Cum Ave Daily Census
34 S ADC("P")=$J((BD("P")/FY("D")),0,1)
35 S ADC("S")=$J((BD("S")/FY("D")),0,1)
36 S ADC("D")=$J((BD("D")/FY("D")),0,1)
37 S ADC("G")=$J((BD("G")/FY("D")),0,1)
38END Q
Note: See TracBrowser for help on using the repository browser.