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