source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNFEDT4.m@ 824

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

initial load of WorldVistAEHR
File size: 3.4 KB
Line 
1SPNFEDT4 ;HISC/DAD-INPUT/OUTPUT PROCESS FOR SURVEY (ROLL&SCROLL) ;9/25/95 09:04
2 ;;2.0;Spinal Cord Dysfunction;;01/02/1997
3 ;
4ADDEDIT(SPNFTYPE,SPNFDFN) ; *** Choose add / edit a record
5 ; SPNFTYPE = 1 - Four Level Functional Measure
6 ; 2 - Clinician reported FIM
7 ; SPNFDFN = IEN in PATIENT file (#2)
8 S SPNFFLAG=$$FIND^SPNFEDT2(SPNFTYPE,SPNFDFN),SPNEXIT=0
9 W !!,$P($G(^DPT(SPNFDFN,0)),U) S Y=+$P(SPNFFLAG,U,2)
10 W " has ",$S(Y=-1:"no",Y=0:"one",1:Y)
11 W " ",$S(SPNFTYPE=1:"Four Level Functional Measure",SPNFTYPE=2:"Clinician Reported FIM",1:"???")
12 W " record",$S(Y:"s",1:""),"."
13 K DIR S DIR(0)="SOM^A:Add a new record;"
14 S DIR("A")="Choose"
15 S DIR("?",1)=" Enter 'A' to create a new record for the selected patient."
16 I $P(SPNFFLAG,U,2)'<0 D
17 . S DIR(0)=DIR(0)_"E:Edit an existing record;"
18 . S DIR("?",2)=" Enter 'E' to edit a pre-existing record for the selected patient."
19 . S DIR("?")=" Choose either 'A' or 'E'."
20 . Q
21 E D
22 . S DIR("?")=" Enter 'A' to add a record, <RETURN> or '^' to exit."
23 . Q
24 D ^DIR W ! S SPNFACTN=Y I $D(DIRUT) S SPNEXIT=1 Q
25 ;
26 I SPNFACTN="A" D
27 . ; *** Add a FIM
28 . K DD,DIC,DINUM,DO
29 . S SPNFD0=-1
30 . S DIC="^SPNL(154.1,",DIC(0)="L"
31 . S DLAYGO=154.1,X=SPNFDFN
32 . D FILE^DICN W ! S SPNFD0=+Y
33 . K DR S DR=".02///^S X="_SPNFTYPE_";.04///TODAY;.04DATE RECORDED"
34 . D EDITFIM^SPNFEDT3(SPNFD0,.DR)
35 . Q
36 I SPNFACTN="E" D
37 . ; *** Edit a FIM
38 . S SPNEXIT=0
39 . I $P(SPNFFLAG,U,2)>0 D Q:SPNEXIT
40 .. ; *** If more than one record, select record to edit
41 .. K DIC S DIC="^SPNL(154.1,",DIC(0)="AEQSZ"
42 .. S DIC("A")="Select DATE RECORDED: ",DIC("W")=""
43 .. S DIC("S")="I $P(^(0),U,1,2)="""_SPNFDFN_U_SPNFTYPE_""""
44 .. S D="C"
45 .. D IX^DIC S SPNFD0=+Y I Y'>0 S SPNEXIT=1
46 .. Q
47 . E D
48 .. ; *** If only one record, select it for editing
49 .. S SPNFD0=+$P(SPNFFLAG,U)
50 .. Q
51 . Q
52 Q
53 ;
54CHKREC(SPNLD0,SPNFD0) ; *** Check record for consistency
55 ; SPNLD0 = IEN in SCD file (#154)
56 ; SPNFD0 = IEN in FIM file (#154.1)
57 N SPNFDATA,SPNFFLD,SPNLDATA,SPNLFLD,SPNPROB
58 F SPNLFLD=2.4,2.5,5.01 D
59 . S SPNLDATA(SPNLFLD)=$$GET1^DIQ(154,SPNLD0_",",SPNLFLD)
60 . Q
61 F SPNLFLD=5.06:.01:5.1 D
62 . S SPNLDATA(SPNLFLD)=$$GET1^DIQ(154,SPNLD0_",",SPNLFLD,"I")
63 . Q
64 F SPNFFLD=2.08:.01:2.11 D
65 . S SPNFDATA(SPNFFLD)=$$GET1^DIQ(154.1,SPNFD0_",",SPNFFLD)
66 . Q
67 F SPNFFLD=2.08:.01:2.11 D
68 . S SPNFDATA(SPNFFLD)=$$GET1^DIQ(154.1,SPNFD0_",",SPNFFLD,"I")
69 . Q
70 S SPNPROB=0
71 W !!,$TR($J("",80)," ","="),!,"Checking data for inconsistencies...",!
72 I SPNLDATA(5.01)'["OTHER",SPNLDATA(2.4)]"" D
73 . W !,"CAUSE OF INJURY is not 'OTHER', DESCRIBE CAUSE OTHER should be blank.",$C(7)
74 . S SPNPROB=SPNPROB+1
75 . Q
76 I SPNLDATA(5.06)=1,SPNLDATA(5.08)=1 D
77 . W !,"ONE ARM AFFECTED and BOTH ARMS AFFECTED are both answered 'YES'.",$C(7)
78 . S SPNPROB=SPNPROB+1
79 . Q
80 I SPNLDATA(5.07)=1,SPNLDATA(5.09)=1 D
81 . W !,"ONE LEG AFFECTED and BOTH LEGS AFFECTED are both answered 'YES'.",$C(7)
82 . S SPNPROB=SPNPROB+1
83 . Q
84 I SPNLDATA(5.1)'>0,SPNLDATA(2.5)]"" D
85 . W !,"OTHER BODY PART AFFECTED is 'NO', DESCRIBE OTHER BODY PART should be blank.",$C(7)
86 . S SPNPROB=SPNPROB+1
87 . Q
88 I SPNFDATA(2.08)'>0,SPNFDATA(2.09) D
89 . W !,"HELP DURING LAST 2 WEEKS is 'NO', NUMBER OF HOURS OF HELP should be blank.",$C(7)
90 . S SPNPROB=SPNPROB+1
91 . Q
92 I SPNFDATA(2.1)>4,SPNFDATA(2.11)>0 D
93 . W !,"RECEIVED MOST MEDICAL CARE is 'NON-VA ONLY' or 'DID NOT SEE DOCTOR/NURSE"
94 . W !,"LAST 5 YRS', VA MOST USED FOR MEDICAL CARE should be blank.",$C(7)
95 . S SPNPROB=SPNPROB+1
96 . Q
97 W:SPNPROB !!
98 W SPNPROB," inconsistenc",$S(SPNPROB=1:"y",1:"ies")," found."
99 Q
Note: See TracBrowser for help on using the repository browser.