120 lines
4.1 KiB
Mathematica
120 lines
4.1 KiB
Mathematica
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
|