[628] | 1 | SPNLGEIP ; 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
|
---|
| 3 | EXTRACT(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
|
---|
| 29 | ADMIT(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
|
---|
| 39 | BSMOVE(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
|
---|
| 53 | SURGERY(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
|
---|
| 64 | NONSURG(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
|
---|