source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNCTCLS.m

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1SPNCTCLS ;WDE/SD CLOSE OPEN CARE EPISODES 154.1 ;6/18/2002
2 ;;2.0;Spinal Cord Dysfunction;**19**;01/02/1997
3 ;
4 ;
5 ;---------------------------------------------------------------------
6CHK ;Calling routine SPNFEDT0
7 ;
8 ; Called when the user is adding a new outcome to the group
9 ; If the outcome has a record type of outpatient follow up
10 ; then prompt to ask them if they want to close this episode
11 ; If Yes then prompt for date and Assign to all outcomes in
12 ; this episode
13 ;
14 ; spnxmit=0 for just the one or 1 for all in the group
15 ; spnclose 0 no to close 1 to close
16 ; Note that spndate is the date recorded asked in the calling rtn
17 ;
18 S (SPNXMIT,SPNCLOSE,SPNEXIT)=0
19 I $P($G(^TMP($J,0)),U,3)'="" S SPNXMIT=0 Q ;episode is closed
20 S %=1 W !,"Do you wish to close this episode of care"
21 D YN^DICN
22 I %Y["?" W !!,"Enter Yes to close this episode or No to leave it open.",! G CHK
23 I %=-1 S SPNEXIT=1 Q
24 S SPNYN=$S(%=1:"Y",1:"N")
25 I SPNYN="Y" D
26 .I $P($G(^TMP($J,0)),U,3)="" S (SPNXMIT,SPNCLOSE)=1 S $P(^TMP($J,0),U,3)=SPNDATE Q
27 ;
28 I SPNYN="N" S SPNXMIT=0,SPNCLOSE=0 ;spnxmit is = 1 to transmit all outcome
29 ; ;in the group
30 ; ;or its set to 0 to just transmit the
31 ; ;current outcome
32 ;I SPNYN="^" S SPNEXIT=1 Q
33 ;I SPNYN="" S SPNEXIT=1 Q
34 I SPNYN="N" I SPNCT=1 D ZAP^SPNOGRDA G RESTART^SPNCTINA
35 I SPNYN="N" I SPNCT=2 D ZAP^SPNOGRDA G RESTART^SPNCTOUA
36 Q
37 ;-------------------------------------------------------------------
38CLOSE ;
39 ;loop through 154.1 and get outcomes with the same care date
40 S SPNA=0 F S SPNA=$O(^TMP($J,SPNA)) Q:SPNA="" S SPNB=0 S SPNB=$O(^TMP($J,SPNA,SPNB)) Q:SPNB="" S SPNC="" S SPNC=$O(^TMP($J,SPNA,SPNB,SPNC)) Q:SPNC="" D
41 .S SPNFIEN=$P($G(^TMP($J,SPNA,SPNB,SPNC)),U,1)
42 .Q:SPNFIEN=""
43 .S DIE="^SPNL(154.1,"
44 .S DA=SPNFIEN,DR="1002///"_$P($G(^TMP($J,0)),U,3)
45 .D ^DIE
46 .K DIE,DA,DR
47 .Q
48 Q
49ZAP ;
Note: See TracBrowser for help on using the repository browser.