source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNCTSHW.m@ 1474

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1SPNCTSHW ;WDE/SD SHOW OUTCOMES ;6/27/02 05:15
2 ;;2.0;Spinal Cord Dysfunction;**19**;01/02/1997
3 ;
4 ;
5EN(SPNDFN) ;
6 ;
7 S SPNA=$P($G(^TMP($J,0)),U,2)
8 I (SPNA=0)!(SPNA="") S SPNEXIT=1 Q ;no care episodes on file
9 D HDR
10 D SHOW
11 Q
12SHOW ; display records in ^tmp($j
13 S (SPNOTOL,SPNFD0,SPNOTNE,SPNW,SPNX,SPNY,SPNZ,SPNIEN,SPNSEL,SPNEXIT,SPNSUB,SPNFD0)=0
14 ; spnw = number spnx = outcome type spny= date recorded
15 S SPNOUT=0
16 S SPNW=0 F S SPNW=$O(^TMP($J,SPNW)) Q:SPNW="" S SPNX=0 F OUT=1:1 S SPNX=$O(^TMP($J,SPNW,SPNX)) Q:SPNX="" S SPNY=0 F S SPNY=$O(^TMP($J,SPNW,SPNX,SPNY)) Q:(SPNY="")!('+SPNY) D I SPNEXIT=1 S SPNZOUT=99999 Q
17 .Q:SPNOUT=1
18 .S SPNFIEN=0 S SPNFIEN=$G(^TMP($J,SPNW,SPNX,SPNY))
19 .W !,SPNW,") ",$$FMTE^XLFDT(SPNX,"5DZP")
20 .W ?15,$$GET1^DIQ(154.1,SPNFIEN_",",.021)
21 .W ?38,$$GET1^DIQ(154.1,SPNFIEN_",",.02)
22 .S SPNEDSS=$P($G(^SPNL(154.1,SPNFIEN,"MS")),U,9) I SPNEDSS'="" W ?62,"EDSS: ",$P($G(^SPNL(154.2,SPNEDSS,0)),U,1)
23 .S SPNSUB=SPNSUB+1,SPNLINE=SPNLINE+1
24 .I SPNLINE>14 D SEL I SPNEXIT=0 I SPNFD0=0 D HDR
25 .I +SPNFD0 Q
26 .Q:SPNOUT=1
27 Q:SPNOUT=1
28 I '+SPNFD0 I SPNEXIT=0 D SEL
29 Q
30HDR ;
31 I $D(IOF) W @IOF
32 S SPNZOUT=0
33 S SPNCTYP=$P($G(^TMP($J,0)),U,4)
34 I $D(SPNHDR)=0 S SPNHDR=" Episodes of care"
35 W !?20,SPNHDR
36 S SPNSSN=$P($G(^DPT(SPNDFN,0)),U,9) S SPNSSN=$E(SPNSSN,1,3)_"-"_$E(SPNSSN,4,5)_"-"_$E(SPNSSN,6,9)
37 W !!,"Patient: ",$P(^DPT(SPNDFN,0),U,1)," SSN: ",SPNSSN
38 S SPNCDT=$P($G(^TMP($J,0)),U,2)
39 S SPNCEDT=$P($G(^TMP($J,0)),U,3)
40 I SPNCDT'="" D
41 .W !?5,"Care Start Date: ",$$FMTE^XLFDT(SPNCDT,"5DZP")
42 .I SPNCEDT'="" W " End Date: ",$$FMTE^XLFDT(SPNCEDT,"5DZP")
43 W !,"--------------------------------------------------------------------------"
44 S SPNLINE=3
45 Q
46SEL ;prompt for a selection from the list
47 Q:SPNOUT=1
48 S (SPNSEL,SPNEXIT,Y)=0,SPNTOT=$P($G(^TMP($J,0)),U,1)
49 W !,"--------------------------------------------------------------------------"
50 W !?2,"Select 1-",SPNSUB," of ",SPNTOT," to view/edit an outcome, '^' to exit, or " I SPNSUB'=SPNTOT W "press"
51 I SPNSUB'=SPNTOT W !?2,"<Return> to see the next group"
52 W !?2,"<A> to Add a new outcome"
53 I SPNCTYP<3 I $G(SPNRTN)'="SPNCTPAA" W !?2,"<P> to view/edit a Previous episode of care"
54 I SPNCTYP<3 I $G(SPNRTN)'="SPNCTPAA" I $P($G(^TMP($J,0)),U,3)'="" W !?2,"<C> to Create a new episode of care"
55PICK R !?5,"Selection: ",SPNSEL:DTIME
56 I SPNSEL["?" W !?2,"Enter a number within the range allowed, or one of the designated keys." G PICK
57 I SPNSEL=0 W !,$C(7),?10,"Selected number is outside the range." G PICK
58 I $S($P($G(^TMP($J,0)),U,3)'="":"AaPpCc^"'[SPNSEL&(SPNSEL'?1.5N),1:"AaPp^"'[SPNSEL&(SPNSEL'?1.5N)) W !,$C(7) G PICK
59 I SPNHDR["Previous"&("Aa0^"'[SPNSEL&(SPNSEL'?1.5N)) W !,$C(7) G PICK
60 I SPNCTYP<3 I SPNSEL="p" S SPNSEL="P"
61 I SPNCTYP<3 I SPNSEL="P" S SPNEXIT=1 S SPNOUT=1 Q
62 I SPNCTYP<3 I SPNSEL="c" S SPNSEL="C"
63 I SPNCTYP<3 I SPNSEL="C" S SPNEXIT=1 S SPNOUT=1 Q
64 I SPNSEL="a" S SPNSEL="A"
65 I SPNSEL="A" S SPNEXIT=1 S SPNOUT=1 Q
66 I SPNSEL="^" S SPNEXIT=1 S SPNOUT=1 Q
67 I (SPNSEL>$P($G(^TMP($J,0)),U,1))!(SPNSEL>SPNSUB) W !,$C(7),?10,"Selected number is outside the range." G PICK
68 I SPNSEL="" I SPNSUB=SPNTOT S SPNEXIT=1 Q
69 I SPNEXIT=0 I +SPNSEL I $D(^TMP($J,SPNSEL)) D
70 .S (SPNB,SPNX)=""
71 .S SPNB=$O(^TMP($J,SPNSEL,SPNB))
72 .S SPNX=$O(^TMP($J,SPNSEL,SPNB,SPNX))
73 .S SPNFD0=$P($G(^TMP($J,SPNSEL,SPNB,SPNX)),U,1)
74 .I SPNFD0="" S SPNFD0="" S SPNEXIT=1 Q
75 .S SPNFTYPE=$P($G(^SPNL(154.1,SPNFD0,0)),U,2)
76 .I SPNFTYPE="" S SPNEXIT=1 Q
77 .S SPNOUT=1 S SPNZOUT=99999 Q
78 I SPNEXIT=1 S SPNOUT=1
79 Q
Note: See TracBrowser for help on using the repository browser.