| 1 | SPNLSCH ;ISC-SF/RAH SCHEDULE NATIONAL REGISTRY EXTRACT ;8/29/95  14:30
 | 
|---|
| 2 | V ;;2.0;Spinal Cord Dysfunction;;01/02/1997
 | 
|---|
| 3 | EN1 ;
 | 
|---|
| 4 |  S SPNLERR=""
 | 
|---|
| 5 |  K X,% D NOW^%DTC S SPNLSDT=X,SPNLSDAT=% K X,%
 | 
|---|
| 6 |  D GETPARM Q:SPNLERR
 | 
|---|
| 7 |  ;D SCHED
 | 
|---|
| 8 |  D ^SPNLS
 | 
|---|
| 9 |  D END
 | 
|---|
| 10 |  Q
 | 
|---|
| 11 | SCHED ;
 | 
|---|
| 12 |  S %DT="AERX",%DT("A")="DATE and TIME to Run SCD Extract:"
 | 
|---|
| 13 |  D ^%DT Q:$D(DTOUT)!(X="")!(X="^")  K %DT
 | 
|---|
| 14 |  I Y=-1 G SCHED
 | 
|---|
| 15 |  S SPNLTMP1=Y
 | 
|---|
| 16 |  S ZTDTH=SPNLTMP1,ZTIO=""
 | 
|---|
| 17 |  S ZTRTN="SPNLS",ZTDESC="SCD SPINAL CORD REGISTRY EXTRACT"
 | 
|---|
| 18 |  D ^%ZTLOAD
 | 
|---|
| 19 |  I '$D(ZTSK) S SPNLERR="2^COULD NOT TASK SCD REGISTRY EXTRACT" D ERRMSG
 | 
|---|
| 20 |  K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
 | 
|---|
| 21 |  Q
 | 
|---|
| 22 | ERRMSG ;
 | 
|---|
| 23 |  I $D(ZTQUEUED) G ERR2
 | 
|---|
| 24 |  W !!,"UNABLE TO SCHEDULE SCD NATIONAL REGISTRY EXTRACT"
 | 
|---|
| 25 |  W !!,"ERROR IS: ",$S(SPNLERR="":"SPNLERR IS NULL",SPNLERR'="":SPNLERR)
 | 
|---|
| 26 |  Q
 | 
|---|
| 27 | ERR2 ;
 | 
|---|
| 28 |  K X,% D NOW^%DTC S SPNLDT=%
 | 
|---|
| 29 |  S XMSUB="SCD REGISTRY EXTRACT ERROR",XMY("G.SPNL SCD COORDINATOR")=""
 | 
|---|
| 30 |  S SPNLFAC=$P(^DIC(4,$P(^XMB(1,1,"XUS"),U,17),99),U,1),SPNLFAC=+$E(SPNLFAC,1,3)
 | 
|---|
| 31 |  S SPNLFNAM=$P(^DIC(4,$P(^XMB(1,1,"XUS"),U,17),0),U,1)
 | 
|---|
| 32 |  S SPNLTEXT(1)="H$ "_SPNLFAC_"^"_SPNLFNAM
 | 
|---|
| 33 |  S SPNLTEXT(2)="E$ "_SPNLDT_"^"_SPNLERR
 | 
|---|
| 34 |  S XMDUZ=.5,XMTEXT="SPNLTEXT("
 | 
|---|
| 35 |  S:'$D(DTIME) DTIME=300 D ^XMD
 | 
|---|
| 36 |  K XMDUZ,SPNTEXT,XMTEXT,XMSUB,XMY
 | 
|---|
| 37 |  Q
 | 
|---|
| 38 | GETPARM ;
 | 
|---|
| 39 |  I '$D(^SPNL(154.91,1,0)) D MAKPARMS Q:SPNLERR
 | 
|---|
| 40 |  S SPNPARMS=^SPNL(154.91,1,0)
 | 
|---|
| 41 |  S SPNLFAC=$P(^SPNL(154.91,1,0),U,1)
 | 
|---|
| 42 |  S SPNLXREC=$P(SPNPARMS,U,2),SPNLXRUN=$P(SPNPARMS,U,3)
 | 
|---|
| 43 |  S SPNLFREQ=$P(SPNPARMS,U,4),SPNLSEEN=$P(SPNPARMS,U,5)
 | 
|---|
| 44 |  S SPNLEXAM=$P(SPNPARMS,U,6),SPNLXMY=$P(^SPNL(154.91,1,0),U,7)
 | 
|---|
| 45 |  Q
 | 
|---|
| 46 | MAKPARMS ;
 | 
|---|
| 47 |  S SPNLYN=""
 | 
|---|
| 48 |  W !!,"===>>>  SITE PARAMETER FILE NOT SET UP  <<<==="
 | 
|---|
| 49 |  W !!,"===>>>  SET IT UP NOW?  <<<===" R SPNLYN:DTIME
 | 
|---|
| 50 |  I '$T!(SPNLYN']"")!(SPNLYN["^") S SPNLERR="7^SITE PARAMETER FILE NOT SET UP" Q
 | 
|---|
| 51 |  I "YNyn"'[SPNLYN W !,"=> Enter only Y for yes or N for no",! G MAKPARMS
 | 
|---|
| 52 |  I "nN"[SPNLYN S SPNLERR="7^SITE PARAMETER FILE NOT SET UP" Q
 | 
|---|
| 53 |  D EN1^SPNLSPAR
 | 
|---|
| 54 |  S SPNLFAC=$P($G(^DIC(4,+$P(^XMB(1,1,"XUS"),U,17),99)),U,1)
 | 
|---|
| 55 |  S SPNLFAC=+$E(SPNLFAC,1,3)
 | 
|---|
| 56 |  I SPNLFAC'>0 S SPNLERR="2^NO FACILITY NUM IN INSTITUTION FILE"
 | 
|---|
| 57 |  Q
 | 
|---|
| 58 | END ;
 | 
|---|
| 59 |  K SPNLERR,SPNLFAC,SPNLFNAM,SPNLSDAT,SPNLSDT,SPNLTMP1,SPNLYN
 | 
|---|
| 60 |  K SPNLTEXT,SPNLXREC,SPNLXRUN,SPNLFREQ,SPNLDT,SPNLSEEN,SPNLEXAM
 | 
|---|
| 61 |  K SPNLXMY,SPNPARMS
 | 
|---|
| 62 |  Q
 | 
|---|