source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNLGEIP.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: 3.0 KB
Line 
1SPNLGEIP ; ISC-SF/GMB - SCD GATHER INPATIENT ADMISSIONS DATA;17 MAY 94 [ 09/01/94 6:23 AM ] ;6/23/95 11:22
2 ;;2.0;Spinal Cord Dysfunction;;01/02/1997
3EXTRACT(DFN,FDATE,TDATE,CLEARTXT,ABORT) ;
4 ; This entry point is to be used solely for gathering data to be sent
5 ; to the national registry.
6 ; DFN Patient's internal entry number in the Patient file
7 ; FDATE "From" date
8 ; TDATE "Thru" date, default=today
9 ; CLEARTXT 1=translate all codes to their meaning,
10 ; 0=don't translate codes (default=0)
11 N RECNR,NODE0,NODE70,ZDD,ZAD
12 I '$D(TDATE) S TDATE=DT
13 I '$D(CLEARTXT) S CLEARTXT=0
14 ; We will take only those admissions whose discharge date is within
15 ; the desired date range.
16 S RECNR=""
17 F S RECNR=$O(^DGPT("B",DFN,RECNR)) Q:RECNR="" D
18 . S NODE0=$G(^DGPT(RECNR,0))
19 . Q:$P(NODE0,U,11)'=1 ; 1=PTF record, 2=census record
20 . S NODE70=$G(^DGPT(RECNR,70))
21 . S ZDD=$P(NODE70,U,1)\1 Q:ZDD=0 ; Discharge date
22 . Q:ZDD<FDATE!(ZDD>TDATE)
23 . S ZAD=$P(NODE0,U,2)\1 Q:ZAD=0 ; Admit date
24 . D ADMIT(ZAD,ZDD,NODE70,CLEARTXT)
25 . D BSMOVE(RECNR,ZAD)
26 . D SURGERY(RECNR,ZAD)
27 . D NONSURG(RECNR,ZAD)
28 Q
29ADMIT(ZAD,ZDD,NODE70,CLEARTXT) ; deal with inpatient admission data
30 N TYPEDISP,BEDSECN,ICDCODES,PIECE
31 S TYPEDISP=$P(NODE70,U,3)
32 I CLEARTXT S TYPEDISP=$$TRANSLAT^SPNLGU(TYPEDISP,45,72)
33 S BEDSECN=$P($G(^DIC(42.4,+$P(NODE70,U,2),0)),U,1)
34 S ICDCODES=""
35 F PIECE=10,16:1:24 D ; get the ICD codes
36 . S ICDCODES=ICDCODES_"^"_$P($G(^ICD9(+$P(NODE70,U,PIECE),0)),U,1)
37 D ADDREC^SPNLGE("IP",ZAD_"^"_ZDD_"^"_BEDSECN_"^"_TYPEDISP_ICDCODES)
38 Q
39BSMOVE(RECNR,MOVEOUT) ; deal with inpatient bedsection movement
40 N SUBRECNR,MOVEIN,NODE0,BEDSECN,ICDCODES,PIECE,MOVEDATE
41 S MOVEDATE=""
42 F S MOVEDATE=$O(^DGPT(RECNR,"M","AM",MOVEDATE)) Q:MOVEDATE'>0 D
43 . S SUBRECNR=$O(^DGPT(RECNR,"M","AM",MOVEDATE,0))
44 . S MOVEIN=MOVEOUT
45 . S MOVEOUT=MOVEDATE\1
46 . S NODE0=$G(^DGPT(RECNR,"M",SUBRECNR,0))
47 . S BEDSECN=$P($G(^DIC(42.4,+$P(NODE0,U,2),0)),U,1)
48 . S ICDCODES=""
49 . F PIECE=5:1:9,11:1:15 D ; get ICD codes
50 . . S ICDCODES=ICDCODES_"^"_$P($G(^ICD9(+$P(NODE0,U,PIECE),0)),U,1)
51 . D ADDREC^SPNLGE("IPM",MOVEIN_"^"_MOVEOUT_"^"_BEDSECN_ICDCODES)
52 Q
53SURGERY(RECNR,ZAD) ; deal with inpatient surgical procedures
54 N SUBRECNR,NODE0,PDATE,PCODES,PIECE
55 S SUBRECNR=0
56 F S SUBRECNR=$O(^DGPT(RECNR,"S",SUBRECNR)) Q:SUBRECNR'>0 D
57 . S NODE0=$G(^DGPT(RECNR,"S",SUBRECNR,0))
58 . S PDATE=$P(NODE0,U,1) ; procedure (operation) date
59 . S PCODES=""
60 . F PIECE=8:1:12 D ; get procedure codes
61 . . S PCODES=PCODES_"^"_$P($G(^ICD0(+$P(NODE0,U,PIECE),0)),U,1)
62 . D ADDREC^SPNLGE("IPS",ZAD_"^"_PDATE_PCODES)
63 Q
64NONSURG(RECNR,ZAD) ; deal with inpatient non-surgical procedures
65 N SUBRECNR,NODE0,PDATE,BEDSECN,PCODES,PIECE
66 S SUBRECNR=0
67 F S SUBRECNR=$O(^DGPT(RECNR,"P",SUBRECNR)) Q:SUBRECNR'>0 D
68 . S NODE0=$G(^DGPT(RECNR,"P",SUBRECNR,0))
69 . S PDATE=$P(NODE0,U,1)\1 ; procedure date
70 . S BEDSECN=$P($G(^DIC(42.4,+$P(NODE0,U,2),0)),U,1)
71 . S PCODES=""
72 . F PIECE=5:1:9 D ; get procedure codes
73 . . S PCODES=PCODES_"^"_$P($G(^ICD0(+$P(NODE0,U,PIECE),0)),U,1)
74 . D ADDREC^SPNLGE("IPP",ZAD_"^"_PDATE_PCODES)
75 Q
Note: See TracBrowser for help on using the repository browser.