| 1 | SPNCTANN ;WDE/SD ANN/CONT MAIN STARTING POINT ;6/27/02  05:15
 | 
|---|
| 2 |  ;;2.0;Spinal Cord Dysfunction;**19,20**;01/02/1997
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ; 
 | 
|---|
| 5 | OTH(SPNCT) ;Starting point called from the option
 | 
|---|
| 6 |  ;patient is asked and then spnct is set to 1
 | 
|---|
| 7 |  ;  the patients dfn is passed back in SPNFDFN
 | 
|---|
| 8 |  D ZAP  ;make sure all is clean before we start
 | 
|---|
| 9 |  D PAT1541^SPNFMENU
 | 
|---|
| 10 |  Q:SPNFEXIT=1
 | 
|---|
| 11 |  Q:$D(SPNFDFN)=""
 | 
|---|
| 12 | RESTART ;
 | 
|---|
| 13 |  I $D(SPNQUIT) Q:SPNQUIT=1
 | 
|---|
| 14 |  S SPNFEXIT=0,SPNEXIT=0
 | 
|---|
| 15 |  S SPNDFN=SPNFDFN
 | 
|---|
| 16 |  S SPNNEW=""
 | 
|---|
| 17 |  D OTHER^SPNCTBLD(SPNCT,SPNDFN)  ;build utility with in patient 
 | 
|---|
| 18 |  S SPNHDR=$S(SPNCT=3:"Annual Evaluation",SPNCT=4:"Continuum of Care",1:"NO CARE TYPE")
 | 
|---|
| 19 |  D EN^SPNCTSHO(SPNDFN)
 | 
|---|
| 20 |  I SPNSEL="" G ZAP^SPNCTINA Q
 | 
|---|
| 21 |  I SPNSEL="A" S SPNEXIT=0 D ADD
 | 
|---|
| 22 |  I SPNEXIT=1 D ZAP Q
 | 
|---|
| 23 |  ;I SPNEXIT=1 D ZAP G RESTART Q
 | 
|---|
| 24 |  I SPNEXIT'=1 I $D(SPNFD0) I $D(SPNFTYPE)  D EDIT^SPNFEDT0
 | 
|---|
| 25 |  ;
 | 
|---|
| 26 |  D ZAP S SPNFDFN=SPNDFN G RESTART
 | 
|---|
| 27 |  Q
 | 
|---|
| 28 | ZAP ;
 | 
|---|
| 29 |  K ^UTILITY($J),^TMP($J)
 | 
|---|
| 30 |  K SPNA,SPNB,SPNC,SPNRTN,SPNSEL,SPNFTYPE,SPNFD0,SPNIEN,SPNSCOR,DIR,DA,DIE,SPNFEXIT,SPNSET,SPNDATA
 | 
|---|
| 31 |  K SPNCEDT,SPNFIEN,SPNTST
 | 
|---|
| 32 |  K SPNCTYP,SPNW,SPNX,SPNY,SPNZ,SPNCNT,SPNXMIT,SPNFIEN,SPNDATE,DIC,DR,SPNLINE,SPNCNT,SPNOUT,SPNOTNE
 | 
|---|
| 33 |  Q
 | 
|---|
| 34 | ADD ; *** Add a record to the OUTCOMES file (#154.1)
 | 
|---|
| 35 |  ;D IN^SPNCTAA  ;prompt for the score type for the new outcome
 | 
|---|
| 36 |  I SPNEXIT=1 D ZAP Q
 | 
|---|
| 37 |  D REPT^SPNFEDT0(SPNFDFN)
 | 
|---|
| 38 |  I $G(SPNFFIM)=0 D ZAP Q
 | 
|---|
| 39 |  I SPNFTYPE="" D ZAP Q  ;no fim record type selected
 | 
|---|
| 40 |  I SPNEXIT=1 D ZAP Q
 | 
|---|
| 41 |  I SPNCT=4 D CONT^SPNCTAA  ;prompt for the score type for the new outcome
 | 
|---|
| 42 |  I SPNEXIT=1 D ZAP Q
 | 
|---|
| 43 |  K DIR S DIR("A")="Enter a New Record Date: "
 | 
|---|
| 44 |  ;D DATES  ;Date range set up of dir(0) set above as saftey
 | 
|---|
| 45 |  S DIR(0)="DAO^:NOW"
 | 
|---|
| 46 |  D ^DIR
 | 
|---|
| 47 |  I '+Y K DIR,Y S SPNFEXIT=1 Q
 | 
|---|
| 48 |  S SPNDATE=Y
 | 
|---|
| 49 |  K DD,DIC,DINUM,DO
 | 
|---|
| 50 |  S SPNFD0=-1
 | 
|---|
| 51 |  S DIC="^SPNL(154.1,",DIC(0)="L"
 | 
|---|
| 52 |  S DLAYGO=154.1,X=SPNFDFN
 | 
|---|
| 53 |  D FILE^DICN W ! S SPNFD0=+Y
 | 
|---|
| 54 |  K DA,DIE,DR
 | 
|---|
| 55 |  I $G(SPNSCOR)="" S SPNSCOR=""
 | 
|---|
| 56 |  S DIE="^SPNL(154.1,",DA=SPNFD0
 | 
|---|
| 57 |  S DR=".02///^S X="_SPNFTYPE_";.04///"_SPNDATE_";.021///"_SPNSCOR_";.023///"_$$EN^SPNMAIN(DUZ)_";1003////"_SPNCT
 | 
|---|
| 58 |  I SPNEXIT=1 D ZAP Q  ;^ OUT OF THE CLOSE QUESTION
 | 
|---|
| 59 |  D ^DIE
 | 
|---|
| 60 |  S SPNNEW="YES"
 | 
|---|
| 61 |  ;
 | 
|---|
| 62 |  Q
 | 
|---|
| 63 | DATES ;set up upper and lower boundaries for the new record
 | 
|---|
| 64 |  ;     If there is a care stop date that will be the upper
 | 
|---|
| 65 |  ;     If there is a care start date that will be the lower
 | 
|---|
| 66 |  ;     Note that TMP is 2nd and 3rd piece is the care start
 | 
|---|
| 67 |  ;                      and endates
 | 
|---|
| 68 |  ;           So if they are adding a outcome to a closed episode
 | 
|---|
| 69 |  ;           piece 2 and 3 will be present.
 | 
|---|
| 70 |  S (SPNX,SPNY)="",DIR(0)=""
 | 
|---|
| 71 |  S SPNX=$P($G(^TMP($J,0)),U,2)
 | 
|---|
| 72 |  S SPNY=$P($G(^TMP($J,0)),U,3)
 | 
|---|
| 73 |  I SPNY'=""  S DIR(0)="DAO^"_SPNX_":"_SPNY_":EX" Q
 | 
|---|
| 74 |  ;spny = close date
 | 
|---|
| 75 |  I SPNSCOR'=5 I SPNY="" S DIR(0)="DAO^"_SPNX_":"_DT_":EX" Q
 | 
|---|
| 76 |  I SPNSCOR=5 I SPNY="" D
 | 
|---|
| 77 |  .S SPNB=""
 | 
|---|
| 78 |  .S SPNA=0 F  S SPNA=$O(^TMP($J,SPNA)) Q:SPNA=""  S SPNB="" S SPNB=$O(^TMP($J,SPNA,SPNB)) Q:SPNB=""
 | 
|---|
| 79 |  .I $G(SPNB)'="" S DIR(0)="DAO^"_SPNB_":"_DT_":EX" Q
 | 
|---|
| 80 |  .Q
 | 
|---|
| 81 |  Q
 | 
|---|