[628] | 1 | SPNFUTL0 ;HISC/DAD-FIM UTILITIES ;10/9/2002
|
---|
| 2 | ;;2.0;Spinal Cord Dysfunction;**16,19**;01/02/1997
|
---|
| 3 | ;
|
---|
| 4 | EN1(SPND0) ; MOTOR SCORE coumputed field (154.1,999.03)
|
---|
| 5 | ; SPND0 = IEN in FIM file (#154.1)
|
---|
| 6 | Q $$SCORE(SPND0,5,17)
|
---|
| 7 | ;
|
---|
| 8 | EN2(SPND0) ; COGNITIVE SCORE coumputed field (154.1,999.04)
|
---|
| 9 | ; SPND0 = IEN in FIM file (#154.1)
|
---|
| 10 | Q $S($P($G(^SPNL(154.1,SPND0,0)),U,2)=1:"N/A",1:$$SCORE(SPND0,18,22))
|
---|
| 11 | ;
|
---|
| 12 | EN3(SPND0) ; TOTAL SCORE coumputed field (154.1,999.05)
|
---|
| 13 | ; SPND0 = IEN in FIM file (#154.1)
|
---|
| 14 | Q $$SCORE(SPND0,5,$S($P($G(^SPNL(154.1,SPND0,0)),U,2)=1:17,1:22))
|
---|
| 15 | EN5(SPND0) ; CHART TOTAL SCORE
|
---|
| 16 | ; SPND0 = IEN in FIM file (#154.1)
|
---|
| 17 | N SPNLCNT
|
---|
| 18 | S SPNLSCR=0
|
---|
| 19 | F SPNLCNT=1:1:6 S SPNLSCR=SPNLSCR+$P($G(^SPNL(154.1,SPND0,"CHART")),U,SPNLCNT)
|
---|
| 20 | Q SPNLSCR
|
---|
| 21 | ;
|
---|
| 22 | SCORE(SPND0,SPNBEG,SPNEND) ; Compute FIM score
|
---|
| 23 | ; SPND0 = IEN in FIM file (#154.1)
|
---|
| 24 | ; SPNBEG = Beginning piece position on the FIM file (#154.1) zero node
|
---|
| 25 | ; SPNEND = Ending piece position on the FIM file (#154.1) zero node
|
---|
| 26 | ;
|
---|
| 27 | N SPNCOUNT,SPNERROR,SPNLEVEL,SPNNUMBR,SPNPIECE,SPNSCORE,SPNTYPE,SPNZERO
|
---|
| 28 | S (SPNSCORE,SPNCOUNT,SPNERROR)=0
|
---|
| 29 | S SPNZERO=$G(^SPNL(154.1,+$G(SPND0),0)),SPNTYPE=$P(SPNZERO,U,2)
|
---|
| 30 | ;
|
---|
| 31 | I "^1^2^"[(U_SPNTYPE_U) D
|
---|
| 32 | . F SPNPIECE=SPNBEG:1:SPNEND D Q:SPNERROR
|
---|
| 33 | .. S SPNLEVEL=+$P(SPNZERO,U,SPNPIECE)
|
---|
| 34 | .. I SPNLEVEL>0 D
|
---|
| 35 | ... S SPNLEVEL(0)=$G(^SPNL(154.11,SPNLEVEL,0))
|
---|
| 36 | ... S SPNNUMBR=$P(SPNLEVEL(0),U),SPNTYPE(0)=$P(SPNLEVEL(0),U,3)
|
---|
| 37 | ... I SPNNUMBR'>0 S SPNERROR=1 Q
|
---|
| 38 | ... I SPNTYPE=1,SPNTYPE(0)'=1 S SPNERROR=1 Q
|
---|
| 39 | ... I SPNTYPE=2,"^2^3^4^"'[(U_SPNTYPE(0)_U) S SPNERROR=1 Q
|
---|
| 40 | ... S SPNSCORE=SPNSCORE+SPNNUMBR,SPNCOUNT=SPNCOUNT+1
|
---|
| 41 | ... Q
|
---|
| 42 | .. Q
|
---|
| 43 | . Q
|
---|
| 44 | E S SPNERROR=1
|
---|
| 45 | ;
|
---|
| 46 | I SPNCOUNT'>0!SPNERROR S SPNSCORE="ERROR"
|
---|
| 47 | E D
|
---|
| 48 | . S SPNSCORE=$J((SPNSCORE/SPNCOUNT)*(SPNEND-SPNBEG+1),0,1)
|
---|
| 49 | . I SPNCOUNT'=(SPNEND-SPNBEG+1) S SPNSCORE=SPNSCORE_"*"
|
---|
| 50 | . Q
|
---|
| 51 | ;
|
---|
| 52 | Q SPNSCORE
|
---|
| 53 | ;
|
---|
| 54 | AA(SPNFD0,SPNFX,SPNPIECE,SPNFACTN) ; *** AA Xref set / kill logic
|
---|
| 55 | ; SPND0 = FILE file (#154.1) IEN
|
---|
| 56 | ; SPNFX = The value of the field
|
---|
| 57 | ; SPNPIECE = The piece position of the field
|
---|
| 58 | ; SPNFACTN = Xref action (S - Set, K - Kill)
|
---|
| 59 | ;
|
---|
| 60 | N SPNFDATE,SPNFDFN,SPNFTYPE,SPNFZERO
|
---|
| 61 | S SPNFZERO=$G(^SPNL(154.1,+SPNFD0,0))
|
---|
| 62 | S SPNFDFN=$S(SPNPIECE=1:SPNFX,1:$P(SPNFZERO,U))
|
---|
| 63 | S SPNFTYPE=$S(SPNPIECE=2:SPNFX,1:$P(SPNFZERO,U,2))
|
---|
| 64 | S SPNFDATE=$S(SPNPIECE=4:SPNFX,1:$P(SPNFZERO,U,4))
|
---|
| 65 | I (SPNFDFN="")!(SPNFTYPE="")!(SPNFDATE="") Q
|
---|
| 66 | I SPNFACTN="S" D
|
---|
| 67 | . S ^SPNL(154.1,"AA",SPNFTYPE,SPNFDFN,SPNFDATE,SPNFD0)=""
|
---|
| 68 | . Q
|
---|
| 69 | I SPNFACTN="K" D
|
---|
| 70 | . K ^SPNL(154.1,"AA",SPNFTYPE,SPNFDFN,SPNFDATE,SPNFD0)
|
---|
| 71 | . Q
|
---|
| 72 | Q
|
---|
| 73 | ;
|
---|
| 74 | AB(SPNFD0,SPNFX,SPNPIECE,SPNFACTN) ; *** AB Xref set / kill logic
|
---|
| 75 | ; SPND0 = FILE file (#154.1) IEN
|
---|
| 76 | ; SPNFX = The value of the field
|
---|
| 77 | ; SPNPIECE = The piece position of the field
|
---|
| 78 | ; SPNFACTN = Xref action (S - Set, K - Kill)
|
---|
| 79 | ;
|
---|
| 80 | N SPNFDATE,SPNFDFN,SPNFZERO
|
---|
| 81 | S SPNFZERO=$G(^SPNL(154.1,+SPNFD0,0))
|
---|
| 82 | S SPNFDFN=$S(SPNPIECE=1:SPNFX,1:$P(SPNFZERO,U))
|
---|
| 83 | S SPNFDATE=$S(SPNPIECE=4:SPNFX,1:$P(SPNFZERO,U,4))
|
---|
| 84 | I (SPNFDFN="")!(SPNFDATE="") Q
|
---|
| 85 | I SPNFACTN="S" D
|
---|
| 86 | . S ^SPNL(154.1,"AB",SPNFDFN,SPNFDATE,SPNFD0)=""
|
---|
| 87 | . Q
|
---|
| 88 | I SPNFACTN="K" D
|
---|
| 89 | . K ^SPNL(154.1,"AB",SPNFDFN,SPNFDATE,SPNFD0)
|
---|
| 90 | . Q
|
---|
| 91 | Q
|
---|
| 92 | ;
|
---|
| 93 | EN4 ; *** EDIT CHECK FOR: HELP LAST 2 WKS / #HRS & RECEIVED MED CARE
|
---|
| 94 | ; *** VA USED FIELD CHECK / DUPLICATE DATE RECORDED
|
---|
| 95 | N SPND0,SPNCNT,SPNFDATA,SPNFERR,SPNFFLD,SPNFTEXT
|
---|
| 96 | K DDSERROR
|
---|
| 97 | F SPNFFLD=.01,.02,.04,2.08:.01 D
|
---|
| 98 | . S SPNFDATA(SPNFFLD)=$$GET^DDSVAL(154.1,DA,SPNFFLD,.SPNFERR,"I")
|
---|
| 99 | . Q
|
---|
| 100 | D EN5^SPNFUTL0(.DA)
|
---|
| 101 | I SPNFDATA(.02)=2 D
|
---|
| 102 | . I SPNFDATA(2.08)'>0,SPNFDATA(2.09) D
|
---|
| 103 | .. S SPNFTEXT=SPNFTEXT+1
|
---|
| 104 | .. S SPNFTEXT(SPNFTEXT)="NUMBER OF HOURS OF HELP should be blank if"
|
---|
| 105 | .. S SPNFTEXT=SPNFTEXT+1
|
---|
| 106 | .. S SPNFTEXT(SPNFTEXT)="HELP DURING LAST 2 WEEKS is answered 'YES'."
|
---|
| 107 | .. Q
|
---|
| 108 | . Q
|
---|
| 109 | I SPNFTEXT D HLP^DDSUTL(.SPNFTEXT) S DDSERROR=1
|
---|
| 110 | Q
|
---|
| 111 | EN6(SPNFDATA) ; This subroutine will vaildate the data prior or to saving it.
|
---|
| 112 | S (SPNFTEXT,SPND0,SPNCNT)=0
|
---|
| 113 | 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
|
---|
| 114 | I SPNCNT D
|
---|
| 115 | . S SPNFTEXT=SPNFTEXT+1
|
---|
| 116 | . S SPNFTEXT(SPNFTEXT)="A Functional Status record already exists for this date."
|
---|
| 117 | . S SPNFTEXT=SPNFTEXT+1
|
---|
| 118 | . S SPNFTEXT(SPNFTEXT)="Please change the DATE RECORDED to a different date."
|
---|
| 119 | . Q
|
---|