VistA-WorldVistAEHR/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNHS0.m

51 lines
2.2 KiB
Mathematica

SPNHS0 ;HIRMFO/JCC-HEALTH SUMMARY: SCD EXTRACT ;10/23/01 10:33
;;2.0;Spinal Cord Dysfunction;**10,16**;01/02/1997
EN(SPNDFN,SPNBEG,SPNEND,SPNMAX) ;
;
;Required:
; SPNDFN = PATIENT file (#2) pointer
; SPNBEG = Beginning date
; SPNEND = Ending date
;Optional:
; SPNMAX = Maximum number of occurrences
;Returns:
; ^TMP("SPN",$J,0)=DATA FROM 154
; ^TMP("SPN",$J,154,INVERSE_DATE_ONSET) =
; ^TMP("SPN",$J,154.1,INVERSE_DATE_RECORDED,SPNIEN)=
;
I +SPNMAX'>0 S SPNMAX=999
K ^TMP("SPN",$J)
I $O(^SPNL(154,"B",SPNDFN,0))'>0 G EXIT
S SPNIEN=$O(^SPNL(154.1,"B",SPNDFN,0))
S SPNCNT=0,SPNDATE=SPNEND+.0000001
F S SPNDATE=$O(^SPNL(154.1,"AB",SPNDFN,SPNDATE),-1) Q:SPNDATE'>0!(SPNCNT=SPNMAX) D
.I SPNDATE<SPNBEG Q
.S SPNIEN=0 F S SPNIEN=$O(^SPNL(154.1,"AB",SPNDFN,SPNDATE,SPNIEN)) Q:SPNIEN'>0 Q:SPNCNT=SPNMAX D ;
..I $$GET1^DIQ(154.1,SPNIEN,.02,"I")>2 Q ; Must be a 4 or 7 level FIM
..S SPNDMS=$$GET1^DIQ(154.1,SPNIEN,999.03)
..S SPNDTY=$E($$GET1^DIQ(154.1,SPNIEN,.02),1,10)
..S SPNDCS=$$GET1^DIQ(154.1,SPNIEN,999.04)
..S SPNDTS=$$GET1^DIQ(154.1,SPNIEN,999.05)
..S ^TMP("SPN",$J,154.1,9999999-SPNDATE,SPNIEN)=SPNDATE_"^"_SPNDMS_"^"_SPNDCS_"^"_SPNDTS_"^"_SPNDTY
..S SPNCNT=SPNCNT+1
S SPNIEN=SPNDFN
S SPNRS=$$GET1^DIQ(154,SPNIEN,.03)
S SPNHI=$$GET1^DIQ(154,SPNIEN,2.1)
S SPNIS=$$GET1^DIQ(154,SPNIEN,2.3)
S SPNPC=$$GET1^DIQ(154,SPNIEN,8.1)
S SPNCOR=$$GET1^DIQ(154,SPNIEN,8.2)
S SPNCI=$$GET1^DIQ(154,SPNIEN,999.03)
S SPNEP=$$GET1^DIQ(154,SPNIEN,999.04)
S SPNMSST=$$GET1^DIQ(154,SPNIEN,2.2)
S ^TMP("SPN",$J,0)=SPNRS_"^"_SPNHI_"^"_SPNIS_"^"_SPNCI_"^"_SPNEP_"^"_SPNPC_"^"_SPNCOR_"^"_SPNMSST
S SPND1=0 F S SPND1=$O(^SPNL(154,SPNIEN,"E",SPND1)) Q:SPND1'>0 D ;
.S SPNONI=$$GET1^DIQ(154.004,SPND1_","_SPNDFN_",",.02,"I") ;DATE OF ONSET
.S SPNON=$$GET1^DIQ(154.004,SPND1_","_SPNDFN_",",.02,"I") ;DATE OF ONSET
.S SPNET=$$GET1^DIQ(154.004,SPND1_","_SPNDFN_",",.01) ;ETIOLOGY
.S SPNCB=$$GET1^DIQ(154.004,SPND1_","_SPNDFN_",",999.01) ;ONSET OF SCD CAUSED BY TRAUMA
.S ^TMP("SPN",$J,154,(9999999-SPNONI)_"^"_SPND1)=SPNON_"^"_SPNET_"^"_SPNCB
.Q
EXIT ;
K SPNRS,SPNHI,SPNIS,SPNCI,SPNEP,SPNON,SPNET,SPNCB,SPNDATE,SPNDMS,SPNDCS,SPNDTS,SPNCNT,SPNMAX,SPND1,SPNONI,SPNIEN,SPNDTY,SPNPC,SPNCOR,SPNMSST
Q