source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNLGRIP.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1SPNLGRIP ; ISC-SF/GMB - SCD GATHER INPATIENT ADMISSIONS DATA;17 MAY 94 [ 07/11/94 10:21 AM ] ;6/23/95 12:10
2 ;;2.0;Spinal Cord Dysfunction;**10**;01/02/1997
3ROLLUP(DFN,FDATE,TDATE,HI) ;
4 ; This entry point is to be used solely for rolling up data to be used
5 ; in a report.
6 ; DFN Patient's internal entry number in the Patient file
7 ; FDATE "From" date
8 ; TDATE "Thru" date, default=today
9 ; HI 1=keep track of individual patient usage
10 ; 0=don't keep track
11 ; Data will be rolled up into the following global:
12 ; ^TMP("SPN",$J,"IP",
13 ; with the following nodes:
14 ; "PAT") # patients
15 ; "DAYS") # admit days
16 ; "ADM") # admits
17 ; "ADM","PAT",admits) # patients with this many admits
18 ; "ADM","DAYS",days) # admits lasting this many days (for MLOS)
19 ; "BS",bsnr) # different patients in this bedsec
20 ; "BS",bsnr,"NAME") name of the bedsec
21 ; "BS",bsnr,"DAYS") # days in this bedsec
22 ; "BS",bsnr,"STAYS") # stays in this bedsec
23 ; "BS",bsnr,"DAYS",days) # stays lasting this many days in this bedsec (for MLOS)
24 ; "HI","H1",-admits,-days,DFN) track usage by individual patient,
25 ; ranked by number of admits and admit days
26 ; "HI","H2",-days,-admits,DFN) track usage by individual patient,
27 ; ranked by number of admit days and admits
28 N RECNR,NODE0,NODE70,ZDD,ZAD,BS,ADMDAYS,NUMADMS,BSNR,X,X1,X2
29 I '$D(TDATE) S TDATE=DT
30 ; We will take all admissions which overlap the desired range, and adjust
31 ; the admit and/or discharge dates to conform with the desired range.
32 S (ADMDAYS,NUMADMS,RECNR)=0 ; for each inpatient record
33 F S RECNR=$O(^DGPT("B",DFN,RECNR)) Q:RECNR="" D
34 . S NODE0=$G(^DGPT(RECNR,0))
35 . Q:$P(NODE0,U,11)'=1 ; 1=PTF record, 2=census record
36 . ;wde/line added below to block fee basis records in the count 2/18/99
37 . I $P(NODE0,U,4)=1 Q
38 . S NODE70=$G(^DGPT(RECNR,70))
39 . S ZDD=$P(NODE70,U,1)\1 ; Discharge date
40 . Q:ZDD'=0&(ZDD<FDATE)
41 . S ZAD=$P(NODE0,U,2)\1 Q:ZAD>TDATE ; Admit date
42 . D ADMIT
43 . D BSMOVE
44 Q:NUMADMS=0
45 S ^("PAT")=$G(^TMP("SPN",$J,"IP","PAT"))+1
46 S ^("DAYS")=$G(^TMP("SPN",$J,"IP","DAYS"))+ADMDAYS
47 S ^("ADM")=$G(^TMP("SPN",$J,"IP","ADM"))+NUMADMS
48 S ^(NUMADMS)=$G(^TMP("SPN",$J,"IP","ADM","PAT",NUMADMS))+1
49 S BSNR="" ; for each bedsection stayed in
50 F S BSNR=$O(BS(BSNR)) Q:BSNR="" D
51 . S ^(BSNR)=$G(^TMP("SPN",$J,"IP","BS",BSNR))+1
52 . S ^("STAYS")=$G(^TMP("SPN",$J,"IP","BS",BSNR,"STAYS"))+BS(BSNR)
53 Q:'HI
54 S ^TMP("SPN",$J,"IP","HI","H1",-NUMADMS,-ADMDAYS,DFN)=""
55 S ^TMP("SPN",$J,"IP","HI","H2",-ADMDAYS,-NUMADMS,DFN)=""
56 Q
57ADMIT ; deal with inpatient admission data
58 ; Figure out length, in days, of adjusted (if necessary) admission
59 S X2=$S(ZAD<FDATE:FDATE,1:ZAD)
60 S X1=$S(ZDD>TDATE:TDATE,ZDD=0:TDATE,1:ZDD)
61 D ^%DTC
62 S ^(X+1)=$G(^TMP("SPN",$J,"IP","ADM","DAYS",X+1))+1
63 S ADMDAYS=ADMDAYS+X+1 ; total admit days
64 S NUMADMS=NUMADMS+1 ; number of admissions
65 Q
66BSMOVE ; Deal with inpatient bedsection movements.
67 ; Completed movements (those with moveout dates) are in the "AM" index.
68 N MOVEIN,MOVEOUT,MOVEDATE,SUBRECNR
69 S MOVEOUT=ZAD
70 S MOVEDATE=""
71 F S MOVEDATE=$O(^DGPT(RECNR,"M","AM",MOVEDATE)) Q:MOVEDATE'>0 D Q:MOVEIN>TDATE
72 . S MOVEIN=MOVEOUT
73 . S MOVEOUT=MOVEDATE\1
74 . Q:MOVEOUT<FDATE!(MOVEIN>TDATE)
75 . S SUBRECNR=$O(^DGPT(RECNR,"M","AM",MOVEDATE,0))
76 . D BS(SUBRECNR)
77 ; The following could also be Q:ZDD'=""
78 Q:$G(SUBRECNR)=1 ; The current (and last) bedsection is always in
79 ; subrecord 1. If we get past this Quit, then the patient is still in
80 ; hospital and the current bedsection would not be in the "AM" index
81 ; because the patient hasn't yet moved out.
82 S MOVEIN=MOVEOUT
83 S MOVEOUT=TDATE
84 Q:MOVEIN>TDATE
85 D BS(1)
86 Q
87BS(SUBRECNR) ;
88 N BSDAYS,BSNR
89 S X2=$S(MOVEIN<FDATE:FDATE,1:MOVEIN)
90 S X1=$S(MOVEOUT>TDATE:TDATE,1:MOVEOUT)
91 D ^%DTC
92 S BSDAYS=X+1
93 S BSNR=+$P($G(^DGPT(RECNR,"M",SUBRECNR,0)),U,2)
94 S BS(BSNR)=$G(BS(BSNR))+1 ; number of stays in this bedsection
95 S ^("DAYS")=$G(^TMP("SPN",$J,"IP","BS",BSNR,"DAYS"))+BSDAYS
96 S ^(BSDAYS)=$G(^TMP("SPN",$J,"IP","BS",BSNR,"DAYS",BSDAYS))+1
97 Q
98NAMEIT ;
99 N BSNR,BSNAME
100 S BSNR=""
101 F S BSNR=$O(^TMP("SPN",$J,"IP","BS",BSNR)) Q:BSNR="" D
102 . S BSNAME=$P($G(^DIC(42.4,BSNR,0)),U,1)
103 . S:BSNAME="" BSNAME="Not Identified"
104 . S ^TMP("SPN",$J,"IP","BS",BSNR,"NAME")=BSNAME
105 Q
Note: See TracBrowser for help on using the repository browser.