[628] | 1 | SPNCTOUB ;WDE/SD OUTPATIENT CREATE NEW EPISODE ;6/27/02 05:15
|
---|
| 2 | ;;2.0;Spinal Cord Dysfunction;**19,21**;01/02/1997
|
---|
| 3 | ;
|
---|
| 4 | ;
|
---|
| 5 | IN ;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 | ;I SPNSEL'="A" D ZAP Q
|
---|
| 14 | ;I SPNEXIT=1 D ZAP Q
|
---|
| 15 | ;Q
|
---|
| 16 | ZAP ;
|
---|
| 17 | Q
|
---|
| 18 | ADD ; *** Add a record to the OUTCOMES file (#154.1)
|
---|
| 19 | 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.
|
---|
| 20 | .W !!?10,"You need to add an Outcome to the current episode and select"
|
---|
| 21 | .W !?10,"a Score Type of OUTPT FOLLOW-UP (END)."
|
---|
| 22 | .R !?15,"Press Return to continue ",SPNZ:DTIME K SPNZ
|
---|
| 23 | .Q
|
---|
| 24 | I $P($G(^TMP($J,0)),U,2)=0 D
|
---|
| 25 | .W !,*7,?10,"There are no OUTPATIENT 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="^" I $D(^TMP($J,1)) D ZAP^SPNCTINA G RESTART^SPNCTOUA
|
---|
| 32 | I %Y="^" I $D(^TMP($J,1))=0 D ZAP^SPNCTINA G KILL^SPNCTINA
|
---|
| 33 | I %=2 I $D(^TMP($J,1))=0 G KILL^SPNCTINA
|
---|
| 34 | I %=2 I $D(^TMP($J,1)) D ZAP^SPNCTINA G RESTART^SPNCTOUA
|
---|
| 35 | I %Y["?" D G RESTART^SPNCTOUA
|
---|
| 36 | .W !!?5,"Enter a Y to create a new OUTPATIENT episode."
|
---|
| 37 | .W !?5,"Enter a N or just Return to return to the last episode"
|
---|
| 38 | .R !!?10,"Press Return to continue",SPNASK:DTIME K SPNASK W !
|
---|
| 39 | I %'=1 D ZAP^SPNCTINA G RESTART^SPNCTOUA Q
|
---|
| 40 | I %'=1 D ZAP S SPNXIT=1 Q
|
---|
| 41 | ;set the score type to outpt start
|
---|
| 42 | S SPNSCOR=6,SPNXMIT=0,SPNEXIT=0
|
---|
| 43 | I $G(SPNFDFN)="" I +$G(SPNDFN) S SPNFDFN=SPNDFN
|
---|
| 44 | I SPNFDFN="" D ZAP^SPNOGRDA Q
|
---|
| 45 | D REPT^SPNFEDT0(SPNFDFN)
|
---|
| 46 | I $D(SPNFTYPE)=0 D ZAP Q
|
---|
| 47 | I SPNFTYPE="" D ZAP Q ;no fim record type selected
|
---|
| 48 | I SPNEXIT=1 D ZAP Q
|
---|
| 49 | I '+SPNSCOR D ZAP Q
|
---|
| 50 | K DIR S DIR("A")="Enter a New Record Date: "
|
---|
| 51 | ;
|
---|
| 52 | D DATES ;Date range set up of dir(0) set above as saftey
|
---|
| 53 | D ^DIR
|
---|
| 54 | I '+Y K DIR,Y S SPNFEXIT=1 Q
|
---|
| 55 | S SPNDATE=Y
|
---|
| 56 | K DD,DIC,DINUM,DO
|
---|
| 57 | S SPNFD0=-1
|
---|
| 58 | S DIC="^SPNL(154.1,",DIC(0)="L"
|
---|
| 59 | S DLAYGO=154.1,X=SPNFDFN
|
---|
| 60 | D FILE^DICN W ! S SPNFD0=+Y
|
---|
| 61 | K DA,DIE,DR
|
---|
| 62 | K ^TMP($J) ;CLEAN UP THE LAST TABLE OF CARE
|
---|
| 63 | I $G(SPNSCOR)="" S SPNSCOR=""
|
---|
| 64 | S DIE="^SPNL(154.1,",DA=SPNFD0
|
---|
| 65 | S SPNCDT=SPNDATE
|
---|
| 66 | I SPNCDT="" W !,"No care start date is on file for this patient!" D ZAP Q
|
---|
| 67 | S DR=".02///^S X="_SPNFTYPE_";.04///"_SPNDATE_";.021///"_SPNSCOR_";.023///"_$$EN^SPNMAIN(DUZ)_";1001///"_SPNCDT_";1003////2"
|
---|
| 68 | D ^DIE
|
---|
| 69 | S SPNNEW="YES"
|
---|
| 70 | D EDIT^SPNFEDT0
|
---|
| 71 | D ZAP^SPNCTINA
|
---|
| 72 | S SPNFDFN=SPNDFN
|
---|
| 73 | G RESTART^SPNCTOUA
|
---|
| 74 | Q
|
---|
| 75 | DATES ;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^"_SPNY_":"_DT_":EX" Q
|
---|
| 86 | ;spny = close date
|
---|
| 87 | I SPNX=0 I SPNY="" S DIR(0)="DAO^:NOW" Q
|
---|