source: FOIAVistA/tag/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNFUTL0.m@ 628

SPNFUTL0 ;HISC/DAD-FIM UTILITIES ;10/9/2002
 ;;2.0;Spinal Cord Dysfunction;**16,19**;01/02/1997
 ;
EN1(SPND0) ; MOTOR SCORE coumputed field (154.1,999.03)
 ;  SPND0  = IEN in FIM file (#154.1)
 Q $$SCORE(SPND0,5,17)
 ;
EN2(SPND0) ; COGNITIVE SCORE coumputed field (154.1,999.04)
 ;  SPND0  = IEN in FIM file (#154.1)
 Q $S($P($G(^SPNL(154.1,SPND0,0)),U,2)=1:"N/A",1:$$SCORE(SPND0,18,22))
 ;
EN3(SPND0) ; TOTAL SCORE coumputed field (154.1,999.05)
 ;  SPND0  = IEN in FIM file (#154.1)
 Q $$SCORE(SPND0,5,$S($P($G(^SPNL(154.1,SPND0,0)),U,2)=1:17,1:22))
EN5(SPND0) ; CHART TOTAL SCORE
 ;  SPND0  = IEN in FIM file (#154.1)
 N SPNLCNT
 S SPNLSCR=0
 F SPNLCNT=1:1:6 S SPNLSCR=SPNLSCR+$P($G(^SPNL(154.1,SPND0,"CHART")),U,SPNLCNT)
 Q SPNLSCR
 ;
SCORE(SPND0,SPNBEG,SPNEND) ; Compute FIM score
 ;  SPND0  = IEN in FIM file (#154.1)
 ;  SPNBEG = Beginning piece position on the FIM file (#154.1) zero node
 ;  SPNEND = Ending piece position on the FIM file (#154.1) zero node
 ;
 N SPNCOUNT,SPNERROR,SPNLEVEL,SPNNUMBR,SPNPIECE,SPNSCORE,SPNTYPE,SPNZERO
 S (SPNSCORE,SPNCOUNT,SPNERROR)=0
 S SPNZERO=$G(^SPNL(154.1,+$G(SPND0),0)),SPNTYPE=$P(SPNZERO,U,2)
 ;
 I "^1^2^"[(U_SPNTYPE_U) D
 . F SPNPIECE=SPNBEG:1:SPNEND D  Q:SPNERROR
 .. S SPNLEVEL=+$P(SPNZERO,U,SPNPIECE)
 .. I SPNLEVEL>0 D
 ... S SPNLEVEL(0)=$G(^SPNL(154.11,SPNLEVEL,0))
 ... S SPNNUMBR=$P(SPNLEVEL(0),U),SPNTYPE(0)=$P(SPNLEVEL(0),U,3)
 ... I SPNNUMBR'>0 S SPNERROR=1 Q
 ... I SPNTYPE=1,SPNTYPE(0)'=1 S SPNERROR=1 Q
 ... I SPNTYPE=2,"^2^3^4^"'[(U_SPNTYPE(0)_U) S SPNERROR=1 Q
 ... S SPNSCORE=SPNSCORE+SPNNUMBR,SPNCOUNT=SPNCOUNT+1
 ... Q
 .. Q
 . Q
 E  S SPNERROR=1
 ;
 I SPNCOUNT'>0!SPNERROR S SPNSCORE="ERROR"
 E  D
 . S SPNSCORE=$J((SPNSCORE/SPNCOUNT)*(SPNEND-SPNBEG+1),0,1)
 . I SPNCOUNT'=(SPNEND-SPNBEG+1) S SPNSCORE=SPNSCORE_"*"
 . Q
 ;
 Q SPNSCORE
 ;
AA(SPNFD0,SPNFX,SPNPIECE,SPNFACTN) ; *** AA Xref set / kill logic
 ;  SPND0    = FILE file (#154.1) IEN
 ;  SPNFX    = The value of the field
 ;  SPNPIECE = The piece position of the field
 ;  SPNFACTN = Xref action (S - Set, K - Kill)
 ;
 N SPNFDATE,SPNFDFN,SPNFTYPE,SPNFZERO
 S SPNFZERO=$G(^SPNL(154.1,+SPNFD0,0))
 S SPNFDFN=$S(SPNPIECE=1:SPNFX,1:$P(SPNFZERO,U))
 S SPNFTYPE=$S(SPNPIECE=2:SPNFX,1:$P(SPNFZERO,U,2))
 S SPNFDATE=$S(SPNPIECE=4:SPNFX,1:$P(SPNFZERO,U,4))
 I (SPNFDFN="")!(SPNFTYPE="")!(SPNFDATE="") Q
 I SPNFACTN="S" D
 . S ^SPNL(154.1,"AA",SPNFTYPE,SPNFDFN,SPNFDATE,SPNFD0)=""
 . Q
 I SPNFACTN="K" D
 . K ^SPNL(154.1,"AA",SPNFTYPE,SPNFDFN,SPNFDATE,SPNFD0)
 . Q
 Q
 ;
AB(SPNFD0,SPNFX,SPNPIECE,SPNFACTN) ; *** AB Xref set / kill logic
 ;  SPND0    = FILE file (#154.1) IEN
 ;  SPNFX    = The value of the field
 ;  SPNPIECE = The piece position of the field
 ;  SPNFACTN = Xref action (S - Set, K - Kill)
 ;
 N SPNFDATE,SPNFDFN,SPNFZERO
 S SPNFZERO=$G(^SPNL(154.1,+SPNFD0,0))
 S SPNFDFN=$S(SPNPIECE=1:SPNFX,1:$P(SPNFZERO,U))
 S SPNFDATE=$S(SPNPIECE=4:SPNFX,1:$P(SPNFZERO,U,4))
 I (SPNFDFN="")!(SPNFDATE="") Q
 I SPNFACTN="S" D
 . S ^SPNL(154.1,"AB",SPNFDFN,SPNFDATE,SPNFD0)=""
 . Q
 I SPNFACTN="K" D
 . K ^SPNL(154.1,"AB",SPNFDFN,SPNFDATE,SPNFD0)
 . Q
 Q
 ;
EN4 ; *** EDIT CHECK FOR: HELP LAST 2 WKS / #HRS & RECEIVED MED CARE
 ; *** VA USED FIELD CHECK / DUPLICATE DATE RECORDED
 N SPND0,SPNCNT,SPNFDATA,SPNFERR,SPNFFLD,SPNFTEXT
 K DDSERROR
 F SPNFFLD=.01,.02,.04,2.08:.01 D
 . S SPNFDATA(SPNFFLD)=$$GET^DDSVAL(154.1,DA,SPNFFLD,.SPNFERR,"I")
 . Q
 D EN5^SPNFUTL0(.DA)
 I SPNFDATA(.02)=2 D
 . I SPNFDATA(2.08)'>0,SPNFDATA(2.09) D
 .. S SPNFTEXT=SPNFTEXT+1
 .. S SPNFTEXT(SPNFTEXT)="NUMBER OF HOURS OF HELP should be blank if"
 .. S SPNFTEXT=SPNFTEXT+1
 .. S SPNFTEXT(SPNFTEXT)="HELP DURING LAST 2 WEEKS is answered 'YES'."
 .. Q
 . Q
 I SPNFTEXT D HLP^DDSUTL(.SPNFTEXT) S DDSERROR=1
 Q
EN6(SPNFDATA) ; This subroutine will vaildate the data prior or to saving it.
 S (SPNFTEXT,SPND0,SPNCNT)=0
 F  S SPND0=$O(^SPNL(154.1,"AA",+SPNFDATA(.02),+SPNFDATA(.01),+SPNFDATA(.04),SPND0)) Q:SPND0'>0  I SPND0'=DA S SPNCNT=SPNCNT+1
 I SPNCNT D
 . S SPNFTEXT=SPNFTEXT+1
 . S SPNFTEXT(SPNFTEXT)="A Functional Status record already exists for this date."
 . S SPNFTEXT=SPNFTEXT+1
 . S SPNFTEXT(SPNFTEXT)="Please change the DATE RECORDED to a different date."
 . Q