| 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 | 
|---|