source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNLGSIP.m@ 1742

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

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1SPNLGSIP ; ISC-SF/GMB - SCD GATHER (SPECIFIC) INPATIENT ADMISSIONS DATA;16 JUN 94 [ 07/11/94 10:48 AM ] ;6/23/95 11:46
2 ;;2.0;Spinal Cord Dysfunction;;01/02/1997
3SELECT(DFN,FDATE,TDATE,HI,QLIST) ;
4 ; This entry point is to be used solely for selecting 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 ; "BS",bsnr) # different patients in this bedsec
15 ; "BS",bsnr,"DAYS") # days in this bedsec
16 ; "BS",bsnr,"STAYS") # stays in this bedsec
17 ; "BS",bsnr,"PID",patient name^SSN) stays^days
18 N RECNR,NODE0,NODE70,ZDD,ZAD,STAYS,DAYS,BSNR,PNAME,PSSN
19 I '$D(TDATE) S TDATE=DT
20 ; We will take all admissions which overlap the desired range, and adjust
21 ; the admit and/or discharge dates to conform with the desired range.
22 S RECNR=0 ; for each inpatient record
23 F S RECNR=$O(^DGPT("B",DFN,RECNR)) Q:RECNR="" D
24 . S NODE0=$G(^DGPT(RECNR,0))
25 . Q:$P(NODE0,U,11)'=1 ; 1=PTF record, 2=census record
26 . S NODE70=$G(^DGPT(RECNR,70))
27 . S ZDD=$P(NODE70,U,1)\1 ; Discharge date
28 . Q:ZDD'=0&(ZDD<FDATE)
29 . S ZAD=$P(NODE0,U,2)\1 Q:ZAD>TDATE ; Admit date
30 . D BSMOVE
31 Q:'$D(STAYS)
32 D:HI GETNAME^SPNLRU(DFN,.PNAME,.PSSN)
33 S BSNR="" ; for each bedsection stayed in
34 F S BSNR=$O(STAYS(BSNR)) Q:BSNR="" D
35 . S ^(BSNR)=$G(^TMP("SPN",$J,"IP","BS",BSNR))+1
36 . S ^("STAYS")=$G(^TMP("SPN",$J,"IP","BS",BSNR,"STAYS"))+STAYS(BSNR)
37 . S ^("DAYS")=$G(^TMP("SPN",$J,"IP","BS",BSNR,"DAYS"))+DAYS(BSNR)
38 . S:HI ^TMP("SPN",$J,"IP","BS",BSNR,"PID",PNAME_U_PSSN)=STAYS(BSNR)_U_DAYS(BSNR)
39 Q
40BSMOVE ; Deal with inpatient bedsection movements.
41 ; Completed movements (those with moveout dates) are in the "AM" index.
42 N MOVEIN,MOVEOUT,MOVEDATE,SUBRECNR
43 S MOVEOUT=ZAD
44 S MOVEDATE=""
45 F S MOVEDATE=$O(^DGPT(RECNR,"M","AM",MOVEDATE)) Q:MOVEDATE'>0 D Q:MOVEIN>TDATE
46 . S MOVEIN=MOVEOUT
47 . S MOVEOUT=MOVEDATE\1
48 . Q:MOVEOUT<FDATE!(MOVEIN>TDATE)
49 . S SUBRECNR=$O(^DGPT(RECNR,"M","AM",MOVEDATE,0))
50 . D STAYS(SUBRECNR)
51 ; The following could also be Q:ZDD'=""
52 Q:$G(SUBRECNR)=1 ; The current (and last) bedsection is always in
53 ; subrecord 1. If we get past this Quit, then the patient is still in
54 ; hospital and the current bedsection would not be in the "AM" index
55 ; because the patient hasn't yet moved out.
56 S MOVEIN=MOVEOUT
57 S MOVEOUT=TDATE
58 Q:MOVEIN>TDATE
59 D STAYS(1)
60 Q
61STAYS(SUBRECNR) ;
62 N BSDAYS,BSNR,X,X1,X2
63 S BSNR=+$P($G(^DGPT(RECNR,"M",SUBRECNR,0)),U,2)
64 Q:'$D(QLIST("BS",BSNR))
65 S STAYS(BSNR)=$G(STAYS(BSNR))+1 ; # of stays in this bedsection
66 S X2=$S(MOVEIN<FDATE:FDATE,1:MOVEIN)
67 S X1=$S(MOVEOUT>TDATE:TDATE,1:MOVEOUT)
68 D ^%DTC
69 S BSDAYS=X+1
70 S DAYS(BSNR)=$G(DAYS(BSNR))+BSDAYS ; # of days in this bedsection
71 Q
Note: See TracBrowser for help on using the repository browser.