source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNCTPAA.m@ 1801

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1SPNCTPAA ;WDE/SD PROMPTS FOR PAST EPISODE ;6/28/02 05:15
2 ;;2.0;Spinal Cord Dysfunction;**19**;01/02/1997
3 ;
4 ;
5EN(SPNCT,SPNDFN) ;
6 ; spnw is the care start date
7 ;build utility with all care dates
8 K ^UTILITY($J),TMP($J)
9 S SPNRTN="SPNCTPAA"
10 D EN^SPNCTBLD(SPNCT,SPNDFN)
11 S (SPNW,SPNCDT,SPNCNT)=0
12 S SPNA=0 F S SPNA=$O(^UTILITY($J,SPNCT,SPNA)) Q:SPNA="" D
13 .S SPNB=0 S SPNB=$O(^UTILITY($J,SPNCT,SPNA,SPNB)) Q:SPNB=""
14 .S SPNC=0 S SPNC=$O(^UTILITY($J,SPNCT,SPNA,SPNB,SPNC)) Q:SPNC=""
15 .I $P($G(^SPNL(154.1,SPNC,8)),U,2)="" Q ;close date BLOCKS THE LAST FROM SHOWING
16 .S SPNCNT=SPNCNT+1
17 .I $P($G(^SPNL(154.1,SPNC,8)),U,2)'="" S ^TMP($J,SPNCNT)=SPNA_U_SPNC_U_$P(^SPNL(154.1,SPNC,8),U,2)
18 .S ^TMP($J,0)=SPNCNT_"^^^"_SPNCT ;number of episodes
19 .Q
20 I $D(^TMP($J))=0 D NONE D ZAP^SPNCTINA S SPNEXIT=1 G:SPNCT=1 RESTART^SPNCTINA G:SPNCT=2 RESTART^SPNCTOUA Q
21 S SPNEXIT=0
22 D DISP
23RESTART ;
24 D PAST^SPNCTCUR(SPNCT,SPNCDT) ;spnct = care type spncdt = episode date
25 ;above call builds tmp with the outcomes
26 I SPNCT=1 S SPNHDR="Previous INPATIENT Episode of Care"
27 I SPNCT=2 S SPNHDR="Previous OUTPATIENT Episode of Care"
28 D EN^SPNCTSHW(SPNDFN)
29 I $D(SPNSEL) I SPNSEL="A" D:SPNCT=1 ADD^SPNCTINA D:SPNCT=2 ADD^SPNCTOUA I SPNEXIT'=1 I $D(SPNFD0) I $D(SPNFTYPE) D EDIT^SPNFEDT0
30 I SPNEXIT=1 D ZAP^SPNCTINA G:SPNCT=1 RESTART^SPNCTINA G:SPNCT=2 RESTART^SPNCTOUA Q
31 ;
32 I $D(SPNSEL) I +SPNSEL D
33 .S (SPNA,SPNFD0)=0
34 .S SPNA=$O(^TMP($J,SPNSEL,SPNA))
35 .S SPNFD0=$O(^TMP($J,SPNSEL,SPNA,SPNFD0))
36 .S SPNFTYPE=$P(^SPNL(154.1,SPNFD0,0),U,2) D EDIT^SPNFEDT0
37 .K SPNA,SPNB
38 .Q
39 D ZAP^SPNCTINA
40 D EN^SPNCTBLD(SPNCT,SPNDFN)
41 S SPNRTN="SPNCTPAA"
42 G RESTART
43 Q
44 ;
45DISP ;display the episode dates and prompt for one
46 S SPNLINE=0,SPNEXIT=0
47 D HDR
48 S SPNA=0 F S SPNA=$O(^TMP($J,SPNA)) Q:SPNA="" D
49 .I SPNEXIT=1 D ZAP Q
50 .
51 .W !,SPNA,") ",$$FMTE^XLFDT($P($G(^TMP($J,SPNA)),U,1),"5DZP")
52 .W ?16,$$FMTE^XLFDT($P($G(^TMP($J,SPNA)),U,3),"5DZP")
53 .S SPNLINE=SPNLINE+1
54 .S SPNCNT=SPNA
55 .I SPNLINE>9 D SEL I SPNEXIT=0 D HDR
56 .I SPNEXIT=1 D ZAP Q
57 .Q
58 I SPNEXIT'=1 D SEL
59 Q
60HDR ;
61 I SPNA=$P($G(^TMP($J,0)),U,1) S SPNEXIT=1 Q
62 I $D(IOF) W @IOF
63 W !?20,SPNHDR
64 S SPNSSN=$P($G(^DPT(SPNDFN,0)),U,9) S SPNSSN=$E(SPNSSN,1,3)_"-"_$E(SPNSSN,4,5)_"-"_$E(SPNSSN,6,9)
65 W !!,"Patient: ",$P(^DPT(SPNDFN,0),U,1)," SSN: ",SPNSSN
66 W !!," Date Opened",?16,"Date Closed"
67 W !,"---------------------------------------------------------------------------"
68 S SPNLINE=4
69 Q
70SEL ;
71 W !,"---------------------------------------------------------------------------"
72 W !?2,"Select 1-",SPNCNT," of ",$P(^TMP($J,0),U,1)," to view/edit an episode of care, '^' to exit"
73 I SPNCNT'=$P(^TMP($J,0),U,1) W ", or" W !?2,"press Return to see the next group"
74PICK R !?5,"Selection: ",SPNSEL:DTIME
75 I SPNSEL["?" W !?2,"Enter a number within the range allowed." G PICK
76 I SPNSEL=0 W !,$C(7),?10,"Selected number is outside the range." G PICK
77 I U'[SPNSEL,(SPNSEL'?1.5N) W !,$C(7) G PICK
78 I SPNSEL="" Q
79 I SPNSEL="^" S SPNEXIT=1 Q
80 I $D(^TMP($J,SPNSEL)) D
81 .S SPNEXIT=1
82 .S SPNCDT=$P($G(^TMP($J,SPNSEL)),U,1)
83 .Q
84 I $G(^TMP($J,SPNSEL))="" W !,$C(7),?10,"Selected number is outside the range." G PICK
85 Q
86ZAP ;
87 Q
88NONE ;No episodes on file for this patient
89 I $D(IOF) W @IOF
90 W !?20,$S(SPNCT=1:"Previous INPATIENT Episode(s) of Care",SPNCT=2:"Previous OUTPATIENT Episode(s) of Care",SPNCT=3:"ANNUAL EVALUATIONS",SPNCT=4:"CONTINUUM OF CARE",1:"UNKNOWN")
91 S SPNSSN=$P($G(^DPT(SPNDFN,0)),U,9) S SPNSSN=$E(SPNSSN,1,3)_"-"_$E(SPNSSN,4,5)_"-"_$E(SPNSSN,6,9)
92 W !!,"Patient: ",$P(^DPT(SPNDFN,0),U,1)," SSN: ",SPNSSN
93 W !,"------------------------------------------------------------------------"
94 W !!?5,"There are no Previous episodes for this patient"
95 R !!?10,"Press Return to continue...",SPNX:DTIME
96 Q
Note: See TracBrowser for help on using the repository browser.