source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNLSCH.m@ 1769

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1SPNLSCH ;ISC-SF/RAH SCHEDULE NATIONAL REGISTRY EXTRACT ;8/29/95 14:30
2V ;;2.0;Spinal Cord Dysfunction;;01/02/1997
3EN1 ;
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
11SCHED ;
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
22ERRMSG ;
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
27ERR2 ;
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
38GETPARM ;
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
46MAKPARMS ;
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
58END ;
59 K SPNLERR,SPNLFAC,SPNLFNAM,SPNLSDAT,SPNLSDT,SPNLTMP1,SPNLYN
60 K SPNLTEXT,SPNLXREC,SPNLXRUN,SPNLFREQ,SPNLDT,SPNLSEEN,SPNLEXAM
61 K SPNLXMY,SPNPARMS
62 Q
Note: See TracBrowser for help on using the repository browser.