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:ZDDTDATE) . 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