source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNFPLT1.m@ 1397

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