source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNFPLT0.m@ 648

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1SPNFPLT0 ;HISC/DAD-FIM SCORE REPORT ;9/15/95 10:58
2 ;;2.0;Spinal Cord Dysfunction;**19**;01/02/1997
3 K DIR
4 S DIR(0)="SO^1:Self Report of Function;2:FIM;"
5 S DIR("A")="Select the type of Functional Status you wish to print"
6 S DIR("?",1)="Enter 1 to print Self Report of Function scores"
7 S DIR("?",2)="Enter 2 to print FIM scores"
8 S DIR("?")="Please enter 1 or 2"
9 W ! D ^DIR S SPNFFTYP=Y_U_$G(Y(0)) I $D(DIRUT) G EXIT
10 ;
11 I +SPNFFTYP=2 D G:$D(DIRUT) EXIT
12 . K DIR S DIR(0)="SO^1:Motor Score;2:Cognitive Score;3:Total Score;"
13 . S DIR("A")="Select the type of FIM score you wish to print"
14 . S DIR("?",1)="Enter 1 to print Motor scores"
15 . S DIR("?",2)="Enter 2 to print Cognitive scores"
16 . S DIR("?",3)="Enter 3 to print Total scores"
17 . S DIR("?")="Please enter 1, 2, or 3"
18 . W ! D ^DIR S SPNFSTYP=Y_U_$G(Y(0))
19 . Q
20 E D
21 . S SPNFSTYP="3^Total Score"
22 . Q
23 K DIR S DIR(0)="DOA^:"_DT
24 S DIR("A")="Enter the beginning date range: "
25 S DIR("?")="Enter the beginning date to search for Functional Status scores"
26 W ! D ^DIR S SPNFBDT=Y I $D(DIRUT) G EXIT
27 K DIR S DIR(0)="DOA^"_SPNFBDT_":"_DT
28 S DIR("A")="Enter the ending date range: "
29 S DIR("?")="Enter the ending date to search for Functional Status scores"
30 D ^DIR S SPNFEDT=Y I $D(DIRUT) G EXIT
31 K ^TMP($J,"SPNFPLT0")
32 S SPNDIC="^SPNL(154.1,",SPNDIC(0)="AEMNQZ"
33 S SPNDIC("A")="Select PATIENT: ",SPNUTIL="SPNFPLT0"
34 ;S SPNDIC("S")="I $O(^SPNL(154.1,""AA"",+SPNFFTYP,+Y,0))"
35 S SPNDIC("S")="I $$SCREEN^SPNFPLT0(Y)"
36 S SPNDIC("W")=""
37 D ^SPNUTL0 I SPNQUIT G EXIT
38 ;
39 K %ZIS,IOP S %ZIS="QM" W ! D ^%ZIS G:POP EXIT
40 I $D(IO("Q")) D G EXIT
41 . S ZTRTN="TASK^SPNFPLT0"
42 . S (ZTSAVE("SPNFFTYP"),ZTSAVE("SPNFSTYP"))=""
43 . S (ZTSAVE("SPNFBDT"),ZTSAVE("SPNFEDT"))=""
44 . S ZTSAVE("^TMP($J,""SPNFPLT0"",")=""
45 . S ZTDESC="SCD Functional Status Scores Report"
46 . D ^%ZTLOAD
47 . Q
48TASK ;
49 D PRINT^SPNFPLT1
50EXIT ;
51 D ^%ZISC
52 K %ZIS,DA,DIC,DIQ,DIR,DIRUT,DIROUT,DR,DTOUT,DUOUT,POP,SPNDIC,SPNEXIT
53 K SPNFBDT,SPNFD0,SPNFDATE,SPNFDFN,SPNFEDT,SPNFFTYP,SPNFHI,SPNFLEVL
54 K SPNFLO,SPNFOUND,SPNFPAGE,SPNFSTYP,SPNFTAB,SPNFUNDL,SPNPIECE,SPNQUIT
55 K SPNSCORE,SPNTODAY,SPNUTIL,X,Y,ZTDESC,ZTRTN,ZTSAVE,^TMP($J,"SPNFPLT0")
56 Q
57SCREEN(Y) ;
58 S SPNDOF=+$G(^SPNL(154.1,+Y,0))
59 I '$D(^SPNL(154.1,"AA",+SPNFFTYP,SPNDOF)) G Q
60 S SPNDOF(1)=$O(^SPNL(154.1,"AA",+SPNFFTYP,SPNDOF,0))
61 S SPNDOF(2)=$O(^SPNL(154.1,"AA",+SPNFFTYP,SPNDOF,SPNDOF(1),0))
62 I '$D(^SPNL(154.1,"AA",+SPNFFTYP,SPNDOF,SPNDOF(1),+Y)) G Q
63 I '$O(^SPNL(154.1,"AA",+SPNFFTYP,SPNDOF,0)) G Q
64 I +Y>SPNDOF(2) G Q
65 K SPNDOF
66 Q 1
67Q K SPNDOF
68 Q 0
Note: See TracBrowser for help on using the repository browser.