76 lines
3.0 KiB
Mathematica
76 lines
3.0 KiB
Mathematica
SPNLGEIP ; ISC-SF/GMB - SCD GATHER INPATIENT ADMISSIONS DATA;17 MAY 94 [ 09/01/94 6:23 AM ] ;6/23/95 11:22
|
|
;;2.0;Spinal Cord Dysfunction;;01/02/1997
|
|
EXTRACT(DFN,FDATE,TDATE,CLEARTXT,ABORT) ;
|
|
; This entry point is to be used solely for gathering data to be sent
|
|
; to the national registry.
|
|
; DFN Patient's internal entry number in the Patient file
|
|
; FDATE "From" date
|
|
; TDATE "Thru" date, default=today
|
|
; CLEARTXT 1=translate all codes to their meaning,
|
|
; 0=don't translate codes (default=0)
|
|
N RECNR,NODE0,NODE70,ZDD,ZAD
|
|
I '$D(TDATE) S TDATE=DT
|
|
I '$D(CLEARTXT) S CLEARTXT=0
|
|
; We will take only those admissions whose discharge date is within
|
|
; the desired date range.
|
|
S RECNR=""
|
|
F S RECNR=$O(^DGPT("B",DFN,RECNR)) Q:RECNR="" D
|
|
. S NODE0=$G(^DGPT(RECNR,0))
|
|
. Q:$P(NODE0,U,11)'=1 ; 1=PTF record, 2=census record
|
|
. S NODE70=$G(^DGPT(RECNR,70))
|
|
. S ZDD=$P(NODE70,U,1)\1 Q:ZDD=0 ; Discharge date
|
|
. Q:ZDD<FDATE!(ZDD>TDATE)
|
|
. S ZAD=$P(NODE0,U,2)\1 Q:ZAD=0 ; Admit date
|
|
. D ADMIT(ZAD,ZDD,NODE70,CLEARTXT)
|
|
. D BSMOVE(RECNR,ZAD)
|
|
. D SURGERY(RECNR,ZAD)
|
|
. D NONSURG(RECNR,ZAD)
|
|
Q
|
|
ADMIT(ZAD,ZDD,NODE70,CLEARTXT) ; deal with inpatient admission data
|
|
N TYPEDISP,BEDSECN,ICDCODES,PIECE
|
|
S TYPEDISP=$P(NODE70,U,3)
|
|
I CLEARTXT S TYPEDISP=$$TRANSLAT^SPNLGU(TYPEDISP,45,72)
|
|
S BEDSECN=$P($G(^DIC(42.4,+$P(NODE70,U,2),0)),U,1)
|
|
S ICDCODES=""
|
|
F PIECE=10,16:1:24 D ; get the ICD codes
|
|
. S ICDCODES=ICDCODES_"^"_$P($G(^ICD9(+$P(NODE70,U,PIECE),0)),U,1)
|
|
D ADDREC^SPNLGE("IP",ZAD_"^"_ZDD_"^"_BEDSECN_"^"_TYPEDISP_ICDCODES)
|
|
Q
|
|
BSMOVE(RECNR,MOVEOUT) ; deal with inpatient bedsection movement
|
|
N SUBRECNR,MOVEIN,NODE0,BEDSECN,ICDCODES,PIECE,MOVEDATE
|
|
S MOVEDATE=""
|
|
F S MOVEDATE=$O(^DGPT(RECNR,"M","AM",MOVEDATE)) Q:MOVEDATE'>0 D
|
|
. S SUBRECNR=$O(^DGPT(RECNR,"M","AM",MOVEDATE,0))
|
|
. S MOVEIN=MOVEOUT
|
|
. S MOVEOUT=MOVEDATE\1
|
|
. S NODE0=$G(^DGPT(RECNR,"M",SUBRECNR,0))
|
|
. S BEDSECN=$P($G(^DIC(42.4,+$P(NODE0,U,2),0)),U,1)
|
|
. S ICDCODES=""
|
|
. F PIECE=5:1:9,11:1:15 D ; get ICD codes
|
|
. . S ICDCODES=ICDCODES_"^"_$P($G(^ICD9(+$P(NODE0,U,PIECE),0)),U,1)
|
|
. D ADDREC^SPNLGE("IPM",MOVEIN_"^"_MOVEOUT_"^"_BEDSECN_ICDCODES)
|
|
Q
|
|
SURGERY(RECNR,ZAD) ; deal with inpatient surgical procedures
|
|
N SUBRECNR,NODE0,PDATE,PCODES,PIECE
|
|
S SUBRECNR=0
|
|
F S SUBRECNR=$O(^DGPT(RECNR,"S",SUBRECNR)) Q:SUBRECNR'>0 D
|
|
. S NODE0=$G(^DGPT(RECNR,"S",SUBRECNR,0))
|
|
. S PDATE=$P(NODE0,U,1) ; procedure (operation) date
|
|
. S PCODES=""
|
|
. F PIECE=8:1:12 D ; get procedure codes
|
|
. . S PCODES=PCODES_"^"_$P($G(^ICD0(+$P(NODE0,U,PIECE),0)),U,1)
|
|
. D ADDREC^SPNLGE("IPS",ZAD_"^"_PDATE_PCODES)
|
|
Q
|
|
NONSURG(RECNR,ZAD) ; deal with inpatient non-surgical procedures
|
|
N SUBRECNR,NODE0,PDATE,BEDSECN,PCODES,PIECE
|
|
S SUBRECNR=0
|
|
F S SUBRECNR=$O(^DGPT(RECNR,"P",SUBRECNR)) Q:SUBRECNR'>0 D
|
|
. S NODE0=$G(^DGPT(RECNR,"P",SUBRECNR,0))
|
|
. S PDATE=$P(NODE0,U,1)\1 ; procedure date
|
|
. S BEDSECN=$P($G(^DIC(42.4,+$P(NODE0,U,2),0)),U,1)
|
|
. S PCODES=""
|
|
. F PIECE=5:1:9 D ; get procedure codes
|
|
. . S PCODES=PCODES_"^"_$P($G(^ICD0(+$P(NODE0,U,PIECE),0)),U,1)
|
|
. D ADDREC^SPNLGE("IPP",ZAD_"^"_PDATE_PCODES)
|
|
Q
|