source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNPSR15.m@ 1389

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1SPNPSR15 ;HIRMFO/DAD,WAA-HUNT: CHANGE IN TOTAL FIM SCORE ;9/22/95 12:35
2 ;;2.0;Spinal Cord Dysfunction;**11,19**;01/02/1997
3 ;
4EN1(D0,FIMTYPE,BDELTA,EDELTA,BDATE,EDATE) ; *** Search entry point
5 ; Input:
6 ; ACTION,SEQUENCE = Search ACTION,SEQUENCE number
7 ; D0 = SCD (SPINAL CORD) REGISTRY file (#154) IEN
8 ; ^TMP($J,"SPNPRT",ACTION,SEQUENCE,"RECORD TYPE") = 1 ! 2 ^ External
9 ; ^TMP($J,"SPNPRT",ACTION,SEQUENCE,"BEGINNING DELTA VALUE") = # ^ #
10 ; ^TMP($J,"SPNPRT",ACTION,SEQUENCE,"ENDING DELTA VALUE") = # ^ #
11 ; ^TMP($J,"SPNPRT",ACTION,SEQUENCE,"BEGINNING DATE") = Date ^ Date_(Ext)
12 ; ^TMP($J,"SPNPRT",ACTION,SEQUENCE,"ENDING DATE") = Date ^ Date_(Ext)
13 ; FIMTYPE = Patient FIM Type
14 ; BDELTA = Beginning Delta Value
15 ; EDELTA = Ending Delta Value
16 ; BDATE = Beginning Date
17 ; EDATE = Ending Date
18 ; Output:
19 ; $S( D0_Meets_Search_Criteria : 1 , 1 : 0 )
20 ;
21 N DELTAFIM,DFN,FIMDIFF,I,LASTFIM,MEETSRCH,TOTALFIM
22 S MEETSRCH=0
23 S DELTAFIM("BEGINNING DELTA VALUE")=BDELTA
24 S DELTAFIM("ENDING DELTA VALUE")=EDELTA
25 S RECDATE("BEGINNING DATE")=BDATE
26 S RECDATE("ENDING DATE")=EDATE
27 S SPNLDATE=RECDATE("BEGINNING DATE")-.0000001 K LASTFIM
28 S LASTFIM=0
29 F S SPNLDATE=$O(^SPNL(154.1,"AA",FIMTYPE,D0,SPNLDATE)) Q:(SPNLDATE'>0)!(SPNLDATE>RECDATE("ENDING DATE"))!MEETSRCH D
30 . S SPNLD0=0,SPNLD0=$O(^SPNL(154.1,"AA",FIMTYPE,D0,SPNLDATE,SPNLD0)) Q:SPNLD0'>0!MEETSRCH D
31 .. S TOTALFIM=+$$EN3^SPNFUTL0(SPNLD0)
32 .. I (TOTALFIM'>0) Q
33 .. S FIMDIFF=TOTALFIM-LASTFIM
34 .. I FIMDIFF'<DELTAFIM("BEGINNING DELTA VALUE"),FIMDIFF'>DELTAFIM("ENDING DELTA VALUE") S MEETSRCH=1
35 .. S LASTFIM=TOTALFIM
36 .. Q
37 . Q
38 Q MEETSRCH
39 ;
40EN2(ACTION,SEQUENCE) ; *** Prompt entry point
41 ; Input:
42 ; ACTION,SEQUENCE = Search ACTION,SEQUENCE number
43 ; Output:
44 ; SPNLEXIT = $S( User_Abort/Timeout : 1 , 1 : 0 )
45 ; ^TMP($J,"SPNPRT",ACTION,SEQUENCE,"RECORD TYPE") = 1 ! 2 ^ External
46 ; ^TMP($J,"SPNPRT",ACTION,SEQUENCE,"BEGINNING DELTA VALUE") = # ^ #
47 ; ^TMP($J,"SPNPRT",ACTION,SEQUENCE,"ENDING DELTA VALUE") = # ^ #
48 ; ^TMP($J,"SPNPRT",ACTION,SEQUENCE,"BEGINNING DATE") = Date ^ Date_(Ext)
49 ; ^TMP($J,"SPNPRT",ACTION,SEQUENCE,"ENDING DATE") = Date ^ Date_(Ext)
50 ; ^TMP($J,"SPNPRT",ACTION,SEQUENCE,0) = $$EN1^SPNPSR15(D0,FIMTYPE,BDELTA,EDELTA,BDATE,EDATE)
51 ;
52 N DELTAFIM,DIR,DIRUT,DTOUT,DUOUT,FIMTYPE,I
53 K ^TMP($J,"SPNPRT",ACTION,SEQUENCE)
54 K DIR S DIR(0)="SOAM^1:Self Report of Function;2:FIM;"
55 S DIR("A")="Record Type: "
56 S DIR("?")="Enter 1 for Self Report of Function, or 2 for FIM"
57 D ^DIR S FIMTYPE=Y,FIMTYPE(0)=$G(Y(0))
58 S SPNLEXIT=$S($D(DTOUT):1,$D(DUOUT):1,1:0)
59 Q:SPNLEXIT
60 Q:Y=""
61 S DELTAFIM=$S(FIMTYPE=1:39,1:108)
62 K DIR S DIR(0)="NOA^"_-DELTAFIM_":"_DELTAFIM
63 S DIR("A")="Beginning delta value: "
64 S DIR("?")="Enter a number from "_-DELTAFIM_" to "_DELTAFIM
65 D ^DIR S (DELTAFIM("BEGINNING DELTA VALUE"),BDELTA)=Y
66 S SPNLEXIT=$S($D(DTOUT):1,$D(DUOUT):1,1:0)
67 Q:SPNLEXIT
68 Q:Y=""
69 K DIR S DIR(0)="NOA^"_DELTAFIM("BEGINNING DELTA VALUE")_":"_DELTAFIM
70 S DIR("A")="Ending delta value: "
71 S DIR("?")="Enter a number from "_DELTAFIM("BEGINNING DELTA VALUE")_" to "_DELTAFIM
72 D ^DIR S (DELTAFIM("ENDING DELTA VALUE"),EDELTA)=Y
73 S SPNLEXIT=$S($D(DTOUT):1,$D(DUOUT):1,1:0)
74 Q:SPNLEXIT
75 Q:Y=""
76 S (BDATE,EDATE)=""
77 D EN1^SPNPSR00(ACTION,SEQUENCE+.2,.BDATE,.EDATE) Q:SPNLEXIT
78 S ^TMP($J,"SPNPRT",ACTION,SEQUENCE,"RECORD TYPE")=FIMTYPE_U_FIMTYPE(0)
79 F I="BEGINNING DELTA VALUE","ENDING DELTA VALUE" D
80 . S ^TMP($J,"SPNPRT",ACTION,SEQUENCE+.1,I)=$G(DELTAFIM(I))_U_$G(DELTAFIM(I))
81 . Q
82 I BDATE=""!(EDATE="") K ^TMP($J,"SPNPRT",ACTION,SEQUENCE+.1),^TMP($J,"SPNPRT",ACTION,SEQUENCE) Q
83 S ^TMP($J,"SPNPRT",ACTION,SEQUENCE,0)="$$EN1^SPNPSR15(D0,"_FIMTYPE_","_BDELTA_","_EDELTA_","_BDATE_","_EDATE_")"
84 Q
Note: See TracBrowser for help on using the repository browser.