source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNCTINA.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1SPNCTINA ;WDE/SD INPATIENT MAIN STARTING POINT ;6/27/02 05:15
2 ;;2.0;Spinal Cord Dysfunction;**19,20**;01/02/1997
3 ;
4 ;
5IN ;Starting point called from the option
6 ;patient is asked and then spnct is set to 1
7 ; the patient's dfn is passed back in SPNFDFN
8 D ZAP ;make sure all is clean before we start
9 D KILL
10 D PAT1541^SPNFMENU
11 S SPNNEW=""
12 Q:SPNFEXIT=1
13 Q:$D(SPNFDFN)=""
14RESTART ;
15 I $D(SPNDFN)=0 S SPNDFN=SPNFDFN
16 I $D(SPNDFN)=0 D ZAP Q
17 S SPNNEW=""
18 S SPNCT=1 ;inpatient
19 D EN^SPNCTBLD(SPNCT,SPNDFN) ;build utility with in patient
20 D CUR^SPNCTCUR(SPNCT,SPNDFN) ;build tmp with current
21 S SPNHDR="Current INPATIENT Episode of Care"
22 D EN^SPNCTSHW(SPNDFN)
23 ;MAY NEED AN EXIT HERE AT SOME TIME
24 ;
25 S SPNA=$P($G(^TMP($J,0)),U,2) ;no episodes on file
26 I SPNA=0 D ADD^SPNCTINB D ZAP Q ;start a new episode of care
27 I SPNSEL="P" S SPNHDR="Previous INPATIENT Episode(s) of Care" D EN^SPNCTPAA(SPNCT,SPNDFN) D ZAP Q
28 I SPNSEL="C" D ADD^SPNCTINB D ZAP Q ;episodes on file but closed
29 I SPNSEL="A" D ADD
30 I SPNEXIT=1 D ZAP Q
31 I SPNEXIT'=1 I $D(SPNFD0) I $D(SPNFTYPE) D EDIT^SPNFEDT0
32 ;I SPNEXIT'=1 I $G(SPNCLOSE)'="" I SPNCLOSE=1 D CLOSE^SPNCTCLS S SPNXMIT=1
33 ;
34 D ZAP S SPNFDFN=SPNDFN G RESTART
35 Q
36ZAP ;
37 K ^UTILITY($J),^TMP($J)
38 K SPNA,SPNB,SPNC,SPNRTN,SPNSEL,SPNFTYPE,SPNFD0,SPNIEN,SPNSCOR,DIR,DA,DIE,SPNFEXIT,SPNSET,SPNDATA
39 K SPNCEDT,SPNFIEN,SPNTST
40 K SPNCTYP,SPNW,SPNX,SPNY,SPNZ,SPNCNT,SPNXMIT,SPNFIEN,SPNDATE,DIC,DR,SPNLINE,SPNCNT,SPNOUT,SPNOTNE
41 K SPNNEW,SPNEDSS,SPNASK
42 Q
43ADD ; *** Add a record to the OUTCOMES file (#154.1)
44 I $D(SPNFDFN)=0 I $D(SPNDFN)=0 D ZAP G KILL Q
45 I $D(SPNFDFN)=0 S SPNFDFN=SPNDFN
46 D REPT^SPNFEDT0(SPNFDFN)
47 I $G(SPNFFIM)=0 D ZAP Q
48 D IN^SPNCTAA ;prompt for the score type for the new outcome
49 I SPNEXIT=1 D ZAP Q
50 I SPNFTYPE="" D ZAP Q ;no fim record type selected
51 I SPNEXIT=1 D ZAP Q
52 I '+SPNSCOR D ZAP Q
53 K DIR S DIR("A")="Enter a New Record Date: "
54 D DATES ;Date range set up of dir(0) set above as saftey
55 D ^DIR
56 I '+Y K DIR,Y S SPNFEXIT=1 Q
57 S SPNDATE=Y
58 K DD,DIC,DINUM,DO
59 S SPNFD0=-1
60 S DIC="^SPNL(154.1,",DIC(0)="L"
61 S DLAYGO=154.1,X=SPNFDFN
62 D FILE^DICN W ! S SPNFD0=+Y
63 K DA,DIE,DR
64 I $G(SPNSCOR)="" S SPNSCOR=""
65 S DIE="^SPNL(154.1,",DA=SPNFD0
66 S SPNCDT=$P($G(^TMP($J,0)),U,2)
67 I SPNCDT="" W !,"No care start date is on file for this patient !" D ZAP Q
68 S DR=".02///^S X="_SPNFTYPE_";.04///"_SPNDATE_";.021///"_SPNSCOR_";.023///"_$$EN^SPNMAIN(DUZ)_";1001///"_SPNCDT_";1002///"_$P($G(^TMP($J,0)),U,3)_";1003////1"
69 I SPNSCOR=5 D CHK^SPNCTCLS
70 I SPNEXIT=1 D ZAP Q ;^ OUT OF THE CLOSE QUESTION
71 D ^DIE
72 S SPNNEW="YES"
73 ;
74 Q
75DATES ;set up upper and lower boundaries for the new record
76 ; If there is a care stop date that will be the upper
77 ; If there is a care start date that will be the lower
78 ; Note that TMP is 2nd and 3rd piece is the care start
79 ; and endates
80 ; So if they are adding a outcome to a closed episode
81 ; piece 2 and 3 will be present.
82 S (SPNX,SPNY)="",DIR(0)=""
83 S SPNX=$P($G(^TMP($J,0)),U,2)
84 S SPNY=$P($G(^TMP($J,0)),U,3)
85 I SPNY'="" S DIR(0)="DAO^"_SPNX_":"_SPNY_":EX" Q
86 ;spny = close date
87 I SPNSCOR'=5 I SPNY="" S DIR(0)="DAO^"_SPNX_":"_DT_":EX" Q
88 I SPNSCOR=5 I SPNY="" D
89 .S SPNB=""
90 .S SPNA=0 F S SPNA=$O(^TMP($J,SPNA)) Q:SPNA="" S SPNB="" S SPNB=$O(^TMP($J,SPNA,SPNB)) Q:SPNB=""
91 .I $G(SPNB)'="" S DIR(0)="DAO^"_SPNB_":"_DT_":EX" Q
92 .Q
93 Q
94KILL ;kills off all vars nothing left behind.
95 ;call at the beginning and very end before returning to menus
96 K SPNDFN,SPNFDFN,SPNNEW,SPNCLS,SPNSCOR,SPNA,SPNB,SPNC,SPND,SPNX,SPNY
97 K SPNZ,DIR,DIE,DIK,DDSCHANG,SPNOTNE,SPNEXIT,SPNFEXIT,SPNFTYPE,SPNIEN
98 K DA,DR,SPNCDT,SPNDATE,SPNCTYP,SPNSET,SPNXMIT,SPNYN,SPNCLOSE
99 K SPNRTN,SPNCDT,SPNCEDT,SPNLINE,SPNCNT,SPNTOT
100 K SPNEDSS
101 Q
Note: See TracBrowser for help on using the repository browser.