102 lines
4.1 KiB
Mathematica
102 lines
4.1 KiB
Mathematica
SPNFPLT1 ;HISC/DAD-FIM SCORE REPORT ;10/18/01 10:41
|
|
;;2.0;Spinal Cord Dysfunction;**3,6,16**;01/02/1997
|
|
PRINT ;
|
|
S SPNTODAY=$$FMTE^XLFDT(DT),SPNEXIT=0,SPNFPAGE(0)=1
|
|
K SPNFUNDL S $P(SPNFUNDL,"-",81)=""
|
|
; I +SPNFSTYP=1 S SPNFHI=91,SPNFLO=13
|
|
; I +SPNFSTYP=2 S SPNFHI=35,SPNFLO=5
|
|
; I +SPNFSTYP=3 S SPNFHI=$S(+SPNFFTYP=1:52,1:126),SPNFLO=$S(+SPNFFTYP=1:13,1:18)
|
|
U IO
|
|
S SPNFDFN(0)=""
|
|
F S SPNFDFN(0)=$O(^TMP($J,"SPNFPLT0",SPNFDFN(0))) Q:SPNFDFN(0)=""!SPNEXIT D
|
|
. S SPNFDFN=0
|
|
. F S SPNFDFN=$O(^TMP($J,"SPNFPLT0",SPNFDFN(0),SPNFDFN)) Q:SPNFDFN'>0!SPNEXIT D DFN
|
|
Q
|
|
;
|
|
DFN ;
|
|
S SPNFDFN(1)=$P($G(^SPNL(154.1,SPNFDFN,0)),U)
|
|
S SPNFDFN(154)=$$GET1^DIQ(154.1,SPNFDFN,.01,"I")
|
|
S SPNFPAGE=1,SPNFOUND=0
|
|
S DIC="^SPNL(154.1," K SPNFDATA
|
|
F DR=999.01,999.02,999.03,999.04,999.05 D
|
|
. S DIQ="SPNFDATA(",DIQ(0)="E",DA=SPNFDFN
|
|
. D EN^DIQ1
|
|
. S:'$D(SPNFDATA(154.1,SPNFDFN,DR,"E")) SPNFDATA(154,SPNFDFN(1),DR,"E")="UNKNOWN"
|
|
D HEAD
|
|
S SPNFDATE=SPNFBDT-.0000001
|
|
F S SPNFDATE=$O(^SPNL(154.1,"AA",+SPNFFTYP,SPNFDFN(1),SPNFDATE)) Q:(SPNFDATE'>0)!(SPNFDATE>(SPNFEDT+.9))!SPNEXIT D
|
|
. S SPNFD0=0
|
|
. F S SPNFD0=$O(^SPNL(154.1,"AA",+SPNFFTYP,SPNFDFN(1),SPNFDATE,SPNFD0)) Q:SPNFD0'>0!SPNEXIT D LINE
|
|
. Q
|
|
I SPNFOUND'>0 W !!,"No data found for this patient"
|
|
D FOOT,PAUSE:'SPNEXIT
|
|
Q
|
|
LINE ;
|
|
S SPNSCORE=-1
|
|
I +SPNFSTYP=1 S SPNSCORE=$$EN1^SPNFUTL0(SPNFD0)
|
|
I +SPNFSTYP=2 S SPNSCORE=$$EN2^SPNFUTL0(SPNFD0)
|
|
I +SPNFSTYP=3 S SPNSCORE=$$EN3^SPNFUTL0(SPNFD0)
|
|
I SPNSCORE<0 Q
|
|
; W !?18,$TR($J("",SPNSCORE-SPNFLO+1*(62/(SPNFHI-SPNFLO+1)))," ","*")
|
|
S SPNSCORE(0)=$S(SPNSCORE:$J(+SPNSCORE,6,1),1:$J(SPNSCORE,6))
|
|
S SPNSCORE(0)=SPNSCORE(0)_$S(SPNSCORE["*":"*",1:"")
|
|
S SPNFOUND=1
|
|
;**MOD,SD/AB,1/27/98, Commented out next line, replaced /w line that follows
|
|
S SPNFDATE(0)=$E(SPNFDATE,4,5)_"/"_$E(SPNFDATE,6,7)_"/"_$E(SPNFDATE,2,3)
|
|
;S SPNFDATE(0)=$$DATEFMT^SPNLRUDT(SPNFDATE,4)
|
|
W !,SPNFDATE(0),?9,SPNSCORE(0)
|
|
S SPNFDATA=$P($G(^SPNL(154.1,SPNFD0,0)),U,5,22)
|
|
I (+SPNFFTYP=1)!(+SPNFSTYP=1) S $P(SPNFDATA,U,14,18)="^^^^"
|
|
I +SPNFSTYP=2 S $P(SPNFDATA,U,1,13)="^^^^^^^^^^^^"
|
|
S SPNFTAB=20
|
|
F SPNPIECE=1:1:18 D
|
|
. S SPNFLEVL=+$P(SPNFDATA,U,SPNPIECE)
|
|
. I SPNFLEVL W ?SPNFTAB,$P($G(^SPNL(154.11,SPNFLEVL,0)),U)
|
|
. S SPNFTAB=SPNFTAB+3
|
|
. Q
|
|
I $Y>(IOSL-6) D PAUSE,HEAD
|
|
Q
|
|
PAUSE ;
|
|
I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S SPNEXIT=$S(Y'>0:1,1:0)
|
|
Q
|
|
HEAD ;
|
|
I SPNEXIT Q
|
|
W:($E(IOST)="C")!(SPNFPAGE(0)>1) @IOF
|
|
S SPNFPAGE(0)=SPNFPAGE(0)+1
|
|
S X=$P(SPNFFTYP,U,2)_" "_$P(SPNFSTYP,U,2)
|
|
W !?80-$L(X)/2,X,?68,"Page: ",SPNFPAGE S SPNFPAGE=SPNFPAGE+1
|
|
S X="for "_SPNFDFN(0)
|
|
W !?80-$L(X)/2,X,?68,SPNTODAY
|
|
S X="SSN: "_SPNFDATA(154.1,SPNFDFN,999.01,"E")
|
|
S X=X_", DOB: "_SPNFDATA(154.1,SPNFDFN,999.02,"E")
|
|
W !?80-$L(X)/2,X
|
|
S X="Extent & Completeness: "_$$GET1^DIQ(154,SPNFDFN(154),999.04,"E")
|
|
S X=X_" - "_$$GET1^DIQ(154,SPNFDFN(154),999.03,"E")
|
|
W !?80-$L(X)/2,X
|
|
S X="Type of Injury: "_$$GET1^DIQ(154,SPNFDFN(154),999.05,"E")
|
|
W !?80-$L(X)/2,X
|
|
W !!,"DATE",?10,"SCORE"
|
|
S SPNFTAB=20
|
|
F SPNPIECE=1:1:$S($P(SPNFFTYP,U,1)=1:13,1:18) W ?SPNFTAB,$C(64+SPNPIECE) S SPNFTAB=SPNFTAB+3
|
|
W !,SPNFUNDL,!
|
|
Q
|
|
FOOT ;
|
|
;-- Check to see if enough room at page bottom to write footer information
|
|
I $Y>(IOSL-8) D PAUSE,HEAD
|
|
;-- Next write blank linefeeds until 8 lines up from the bottom og page
|
|
F W ! Q:$Y=(IOSL-8)
|
|
;-- Now write footer information
|
|
W !,"A-EATING G-BLADDER MANAGEMENT M-STAIRS"
|
|
I $P(SPNFFTYP,U,1)=2 W !,"B-GROOMING H-BOWEL MANAGEMENT N-COMPREHENSION"
|
|
E W !,"B-GROOMING H-BOWEL MANAGEMENT"
|
|
I $P(SPNFFTYP,U,1)=2 W !,"C-BATHING I-TRANSFER TO BED/CHAIR O-EXPRESSION"
|
|
E W !,"C-BATHING I-TRANSFER TO BED/CHAIR"
|
|
I $P(SPNFFTYP,U,1)=2 W !,"D-DRESSING UPPER BODY J-TRANSFER TO TOILET P-SOCIAL INTERACTION"
|
|
E W !,"D-DRESSING UPPER BODY J-TRANSFER TO TOILET"
|
|
I $P(SPNFFTYP,U,1)=2 W !,"E-DRESSING LOWER BODY K-TRANSFER TO TUB/SHOWER Q-PROBLEM SOLVING"
|
|
E W !,"E-DRESSING LOWER BODY K-TRANSFER TO TUB/SHOWER"
|
|
I $P(SPNFFTYP,U,1)=2 W !,"F-TOILETING L-MOVE AROUND INSIDE YOUR HOUSE R-MEMORY"
|
|
E W !,"F-TOILETING L-MOVE AROUND INSIDE YOUR HOUSE"
|
|
W !," Star ""*"" indicates the score is incomplete."
|
|
Q
|