source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNCTINB.m@ 767

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

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1SPNCTINB ;WDE/SD INPATIENT CREATE NEW CARE POINT ;6/27/02 05:15
2 ;;2.0;Spinal Cord Dysfunction;**19,21**;01/02/1997
3 ;
4 ;
5IN ;called when there are no episodes on file and to
6 ;start a new care episode
7 ;Q:SPNFEXIT=1
8 ;Q:$D(SPNFDFN)=""
9 ;S SPNFEXIT=0,SPNEXIT=0
10 ;S SPNDFN=SPNFDFN
11 ;S SPNCT=1 ;inpatient
12 ; ;^ was entered or they are finished with the group
13 ;Q
14ZAP ;was used in another version no longer need but left for future use
15 ;Q
16ADD ; *** Add a record to the OUTCOMES file (#154.1)
17 ;I $D(SPNQUIT) I SPNQUIT=1 Q
18 I $P($G(^TMP($J,0)),U,2)>1 I $P($G(^TMP($J,0)),U,3)="" S SPNSEL="^" S SPNEXIT=1 D Q ;episode is not closed.
19 .W !!?10,"You need to add an Outcome to the current episode and select"
20 .W !?10,"a Score Type of INPT FOLLOW-UP (END)."
21 .R !?15,"Press Return to continue ",SPNZ:DTIME K SPNZ
22 .Q
23 K DIR,DIC,%
24 I $P($G(^TMP($J,0)),U,2)=0 D
25 .W !,*7,?10,"There are no INPATIENT episodes of care on file."
26 .W !?10,"(An ASIA should be entered first if an episode is created.)"
27 .W !?10,"Would you like to create an episode of care"
28 I $G(SPNSEL)["C" D
29 .W !?10,"Would you like to create a new episode of care"
30 S %=1 D YN^DICN
31 ;I %Y="^" D ZAP^SPNCTINA G KILL^SPNCTINA:$G(^TMP($J,1))="" G RESTART^SPNCTINA
32 I %Y="^" I $D(^TMP($J,1)) D ZAP^SPNCTINA G RESTART^SPNCTINA
33 I %Y="^" I $D(^TMP($J,1))=0 D ZAP^SPNCTINA G KILL^SPNCTINA
34 I %=2 I $D(^TMP($J,1))=0 G KILL^SPNCTINA
35 I %=2 I $D(^TMP($J,1)) D ZAP^SPNCTINA G RESTART^SPNCTINA
36 ;I %=2 W !,"zdz" H 2 G ZAP^SPNCTINA:$G(^TMP($J,1))="" G RESTART^SPNCTINA
37 I %Y["?" D G RESTART^SPNCTINA
38 .W !!?5,"Enter a Y to create a new INPATIENT episode."
39 .W !?5,"Enter a N or just Return to return to the last episode"
40 .R !!?10,"Press Return to continue",SPNASK:DTIME K SPNASK W !
41 I %'=1 D ZAP^SPNCTINA G RESTART^SPNCTINA Q
42 I %'=1 D ZAP S SPNEXIT=1 Q
43 ;
44 S SPNSCOR=1,SPNXMIT=0,SPNEXIT=0
45 I $G(SPNFDFN)="" I +$G(SPNDFN) S SPNFDFN=SPNDFN
46 I SPNFDFN="" D ZAP^SPNOGRDA Q
47 D REPT^SPNFEDT0(SPNFDFN)
48 I $D(SPNFTYPE)=0 G ZAP^SPNCTINA Q
49 I SPNFTYPE="" G ZAP^SPNCTINA Q ;no fim record type selected
50 I SPNEXIT=1 D ADD Q
51 I '+SPNSCOR D ADD Q
52 K DIR S DIR("A")="Enter a New Record Date: "
53 D DATES ;Date range set up of dir(0) set above as saftey
54 D ^DIR
55 I '+Y K DIR,Y S SPNFEXIT=1 Q
56 S SPNDATE=Y
57 K DD,DIC,DINUM,DO
58 S SPNFD0=-1
59 S DIC="^SPNL(154.1,",DIC(0)="L"
60 S DLAYGO=154.1,X=SPNFDFN
61 D FILE^DICN W ! S SPNFD0=+Y
62 K DA,DIE,DR
63 K ^TMP($J) ;CLEAN UP THE LAST TABLE OF CARE
64 I $G(SPNSCOR)="" S SPNSCOR=""
65 S DIE="^SPNL(154.1,",DA=SPNFD0
66 S SPNCDT=SPNDATE
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_";1003////1"
69 D ^DIE
70 S SPNNEW="YES"
71 D EDIT^SPNFEDT0
72 D ZAP^SPNCTINA
73 S SPNFDFN=SPNDFN
74 G RESTART^SPNCTINA
75 Q
76DATES ;set up upper and lower boundaries for the new record
77 ; If there is a care stop date that will be the upper
78 ; If there is a care start date that will be the lower
79 ; The new episode start date must be greater then any
80 ; other episodes on file
81 ;
82 ;
83 S (SPNX,SPNY)="",DIR(0)=""
84 S SPNX=$P($G(^TMP($J,0)),U,2)
85 S SPNY=$P($G(^TMP($J,0)),U,3)
86 I SPNY'="" S DIR(0)="DAO^"_SPNY_":"_DT_":EX" Q
87 ;spny = close date
88 I SPNX=0 I SPNY="" S DIR(0)="DAO^:NOW" Q
Note: See TracBrowser for help on using the repository browser.