source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNFUTL0.m@ 1008

Last change on this file since 1008 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1SPNFUTL0 ;HISC/DAD-FIM UTILITIES ;10/9/2002
2 ;;2.0;Spinal Cord Dysfunction;**16,19**;01/02/1997
3 ;
4EN1(SPND0) ; MOTOR SCORE coumputed field (154.1,999.03)
5 ; SPND0 = IEN in FIM file (#154.1)
6 Q $$SCORE(SPND0,5,17)
7 ;
8EN2(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 ;
12EN3(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))
15EN5(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 ;
22SCORE(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 ;
54AA(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 ;
74AB(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 ;
93EN4 ; *** 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
111EN6(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
Note: See TracBrowser for help on using the repository browser.