source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNLUTL0.m@ 674

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

initial load of FOIAVistA 6/30/08 version
File size: 5.4 KB
Line 
1SPNLUTL0 ;HISCWDE,DAD-SCD REGISTRY FILE UTILITIES ;8/16/96 14:06
2 ;;2.0;Spinal Cord Dysfunction;**7,11,13,19**;01/02/1997
3 ;
4EN1(SPND0) ; ***COMPLETENESS OF INJURY
5 ; SPND0 = Internal entry number in SCD REGISTRY file (#154)
6 N SPNDATA,SPNFEEL,SPNINJRY,SPNMOVE
7 S SPNDATA(5)=$G(^SPNL(154,+SPND0,5))
8 S SPNMOVE=$P(SPNDATA(5),U,11),SPNFEEL=$P(SPNDATA(5),U,12)
9 S SPNINJRY=1
10 I (SPNMOVE=1)&(SPNFEEL=1) S SPNINJRY=2
11 I SPNMOVE=2 S SPNINJRY=3
12 I SPNFEEL=2 S SPNINJRY=4
13 I SPNMOVE=3 S SPNINJRY=5
14 I SPNFEEL=3 S SPNINJRY=6
15 I (SPNMOVE=2)&(SPNFEEL=2) S SPNINJRY=7
16 I (SPNMOVE=2)&(SPNFEEL=3) S SPNINJRY=8
17 I (SPNMOVE=3)&(SPNFEEL=2) S SPNINJRY=9
18 I (SPNMOVE=3)&(SPNFEEL=3) S SPNINJRY=10
19 Q $P($T(EN1DATA+SPNINJRY),";",3)
20EN1DATA ;; Completeness of injury text
21 ;;DON'T KNOW
22 ;;NONE
23 ;;INCOMPLETE MOTOR
24 ;;INCOMPLETE SENSORY
25 ;;COMPLETE MOTOR
26 ;;COMPLETE SENSORY
27 ;;INCOMPLETE SENSORY AND MOTOR
28 ;;COMPLETE SENSORY AND INCOMPLETE MOTOR
29 ;;INCOMPLETE SENSORY AND COMPLETE MOTOR
30 ;;COMPLETE SENSORY AND MOTOR
31 ;
32EN2(SPND0) ; *** EXTENT OF PARALYSIS
33 ; SPND0 = Internal entry number in SCD REGISTRY file (#154)
34 N SPNARM,SPNDATA,SPNLEG,SPNXTENT
35 S SPNDATA(5)=$G(^SPNL(154,+SPND0,5))
36 S SPNARM(1)=$P(SPNDATA(5),U,6),SPNARM(2)=$P(SPNDATA(5),U,8)
37 S SPNLEG(1)=$P(SPNDATA(5),U,7),SPNLEG(2)=$P(SPNDATA(5),U,9)
38 S SPNXTENT=1
39 I SPNARM(1)!SPNLEG(1) S SPNXTENT=2
40 I SPNARM(1)&SPNLEG(1) S SPNXTENT=3
41 I SPNLEG(2) S SPNXTENT=4
42 I SPNARM(2)&SPNLEG(2) S SPNXTENT=5
43 Q $P($T(EN2DATA+SPNXTENT),";",3)
44EN2DATA ;; Extent of paralysis text
45 ;;DON'T KNOW
46 ;;MONOPLEGIA
47 ;;HEMIPLEGIA
48 ;;PARAPLEGIA
49 ;;TETRAPLEGIA
50 ;
51EN3(SPNLDA) ; *** ONE/BOTH ARM/LEG & OTHER BODY PART AFFECTED FIELD CHECK
52 N SPNLDATA,SPNLERR,SPNLFLD,SPNLTEXT,DA
53 K DDSERROR
54 S DA=SPNLDA
55 F SPNLFLD=2.4,2.5,5.06:.01:5.1 D
56 . S SPNLDATA(SPNLFLD)=$$GET^DDSVAL(154,DA,SPNLFLD,.SPNLERR,"I")
57 . Q
58 S SPNLDATA(5.01)=$$GET^DDSVAL(154,DA,5.01,.SPNLERR,"E")
59 S SPNLTEXT=0
60 ;I SPNLDATA(5.01)'["OTHER",SPNLDATA(2.4)]"" D
61 ;. S SPNLTEXT=SPNLTEXT+1
62 ;. S SPNLTEXT(SPNLTEXT)="You have not answered OTHER for CAUSE OF INJURY,"
63 ;. S SPNLTEXT=SPNLTEXT+1
64 ;. S SPNLTEXT(SPNLTEXT)="the DESCRIBE OTHER field should be left blank."
65 ;. Q
66 I SPNLDATA(5.06),SPNLDATA(5.08) D
67 . S SPNLTEXT=SPNLTEXT+1
68 . S SPNLTEXT(SPNLTEXT)="You have answered YES to ONE ARM AFFECTED and BOTH ARMS AFFECTED."
69 . S SPNLTEXT=SPNLTEXT+1
70 . S SPNLTEXT(SPNLTEXT)="You may only answer YES to one of these two fields."
71 . Q
72 I SPNLDATA(5.07),SPNLDATA(5.09) D
73 . S SPNLTEXT=SPNLTEXT+1
74 . S SPNLTEXT(SPNLTEXT)="You have answered YES to ONE LEG AFFECTED and BOTH LEGS AFFECTED."
75 . S SPNLTEXT=SPNLTEXT+1
76 . S SPNLTEXT(SPNLTEXT)="You may only answer YES to one of these two fields."
77 . Q
78 I SPNLDATA(5.1)'>0,SPNLDATA(2.5)]"" D
79 . S SPNLTEXT=SPNLTEXT+1
80 . S SPNLTEXT(SPNLTEXT)="You have answered NO to OTHER BODY PART AFFECTED, the"
81 . S SPNLTEXT=SPNLTEXT+1
82 . S SPNLTEXT(SPNLTEXT)="DESCRIBE OTHER field should be left blank."
83 . Q
84 I SPNLTEXT D HLP^DDSUTL(.SPNLTEXT) S DDSERROR=1
85 Q
86 ;
87EN4(SPND0) ; *** Cause of SCD
88 ; Input: SPND0 = Internal entry number in SCD REGISTRY file (#154)
89 ; Output: Traumatic, Non-traumatic, Unknown, Indeterminate
90 S (SPNCAUSE("TC"),SPNCAUSE("NTC"),SPNCAUSE("U"),SPND1)=0
91 F S SPND1=$O(^SPNL(154,SPND0,"E",SPND1)) Q:SPND1'>0 D
92 . S SPNETIOL=$P($G(^SPNL(154,SPND0,"E",SPND1,0)),U,2)
93 . S SPNCAUSE=$P($G(^SPNL(154.03,+SPNETIOL,0)),U,2)
94 . I "^TC^NTC^U^"'[(U_SPNCAUSE_U) Q
95 . S SPNCAUSE(SPNCAUSE)=SPNCAUSE(SPNCAUSE)+1
96 . Q
97 S X=""
98 I SPNCAUSE("TC") S X="TRAUMATIC"
99 I SPNCAUSE("NTC") S X=X_$S(X]"":", ",1:"")_"NON-TRAUMATIC"
100 I SPNCAUSE("U") S X=X_$S(X]"":", ",1:"")_"UNKNOWN"
101 I X="" S X="INDETERMINATE"
102 Q X
103EN5(SPNLDA) ; This routine is to determine if the patient has a
104 ; Clinician on file for this FIM report.
105 ;
106 N SPNLTEXT
107 S SPNLTEXT=0
108 I $O(^SPNL(154.1,SPNLDA,1,0))<1 D
109 . S SPNLTEXT=SPNLTEXT+1
110 . S SPNLTEXT(SPNLTEXT)="This patient has no Clinician entered for this FIM ."
111 . Q
112 I SPNLTEXT D HLP^DDSUTL(.SPNLTEXT) S DDSERROR=1
113 Q
114 ;
115EN6(SPNLDA) ; This is to confirm that the patient does have a Etiology
116 ; on file.
117 ;
118 N SPNLTEXT
119 S SPNLTEXT=0
120 I $O(^SPNL(154,SPNLDA,"E",0))<1 D
121 . S SPNLTEXT=SPNLTEXT+1
122 . S SPNLTEXT(SPNLTEXT)="There is no Cause of SCD (Etioloty) on file for this patient."
123 . Q
124 I SPNLTEXT D HLP^DDSUTL(.SPNLTEXT) S DDSERROR=1
125 Q
126EN7(SPNDT1,SPNDT2,SPNTYP) ; This function is to validate the two dates
127 ; Input:
128 ; SPNDT1 THE FIRST DATE
129 ; SPNDT2 THE SECOND DATE
130 ; THE TYPE OF DATE:
131 ; 1 = RECEIVE DATE
132 ; 2 = NEXT DUE DATE
133 ;
134 N SPNLTEXT K DDSERROR,DDSBR
135 I SPNDT2<SPNDT1 D
136 .S SPNLTEXT(1)="The Date "_$S(SPNTYP=1:"Received",SPNTYP=2:"Next Due",1:"")_" must not be before the Date "_$S(SPNTYP=1:"Offered",SPNTYP=2:"Received",1:"")_"."
137 .S DDSERROR=1
138 .D HLP^DDSUTL(.SPNLTEXT)
139 .S DDSBR=(SPNTYP+1)_U_3_U_3
140 .Q
141 Q
142EN9(SPNDFN) ;See if pt has any etiology is on file.
143 ;wde this is callable from all points just need the ifn of the pt from file 154
144 ; will return 1 if the pt has an etiology
145 ; will return 0 if the pt has zip entered in the etiology field
146 N SPNLFLG,SPNTIFN
147 S (SPNLFLG,SPNTIFN)=0
148 F S SPNTIFN=$O(^SPNL(154,SPNDFN,"E",SPNTIFN)) Q:(SPNTIFN="")!('+SPNTIFN) D Q:+SPNLFLG
149 .I $P(^SPNL(154,SPNDFN,"E",SPNTIFN,0),U,1)'="" S SPNLFLG=1
150 .Q
151 Q SPNLFLG
152EN10 ;data validation for a Reg Status of 'Expired'
153 ;cm Called from Block SPNLPBLK1 of Form SPNLPFM1
154 S SPNLFLG=0
155 S:"EXxex"'[DDSX&($P($G(^DPT(D0,.35)),U,1)) SPNLFLG=1,DDSERROR=1 W:$D(DDSERROR) *7 D:SPNLFLG=1 HLP^DDSUTL("Patient is deceased.")
156 Q
Note: See TracBrowser for help on using the repository browser.