| 1 | SPNLSPAR ;ISC-SF/RAH SITE PARAMETERS EDIT ;4/12/96 09:52
|
|---|
| 2 | V ;;2.0;Spinal Cord Dysfunction;**10**;01/02/1997
|
|---|
| 3 | EN1 ; Entry for Changing all fields except Nat'l Registry.
|
|---|
| 4 | S SPNLERR=""
|
|---|
| 5 | D SETFACS I SPNLERR D ERRMSG G END
|
|---|
| 6 | I '$D(^SPNL(154.91,1,0)) D SETDEFS I SPNLERR D ERRMSG G END
|
|---|
| 7 | S DA=1,DR="[SPNL SCD SITE PARAMETERS]",DIE="^SPNL(154.91," D ^DIE K DIE,DA,DR
|
|---|
| 8 | D END
|
|---|
| 9 | Q
|
|---|
| 10 | SETFACS ;
|
|---|
| 11 | K SPNL
|
|---|
| 12 | S DIC=4.3,DR=217,DA=1,DIQ(0)="EI",DIQ="SPNL" D EN^DIQ1 K DIC,DIQ,DA,DR
|
|---|
| 13 | I '$D(SPNL(4.3,1,217,"E")) S SPNLERR="1^KERNEL SITE PARAMETER ERROR" G SETFEND
|
|---|
| 14 | S SPNLFNAM=SPNL(4.3,1,217,"E")
|
|---|
| 15 | S DIC=4,DA=SPNL(4.3,1,217,"I"),DR=99,DIQ(0)="EI",DIQ="SPNL" D EN^DIQ1 K DIC,DIQ,DR
|
|---|
| 16 | I '$D(SPNL(4,DA,99,"E")) S SPNLERR="2^NO FACILITY NUM IN INSTITUTION FILE" G SETFEND
|
|---|
| 17 | S SPNLFAC=+$E(SPNL(4,DA,99,"E"),1,3)
|
|---|
| 18 | SETFEND ;
|
|---|
| 19 | K SPNL
|
|---|
| 20 | Q
|
|---|
| 21 | SETDEFS ;
|
|---|
| 22 | I '$D(SPNLFAC)!'$D(SPNLFNAM) D SETFACS
|
|---|
| 23 | S DIC="^SPNL(154.91,",DIC(0)="LM",DLAYGO=154.91,X=SPNLFAC,DINUM=1 D ^DIC K DIC,DLAYGO,DINUM
|
|---|
| 24 | I Y=-1 S SPNLERR="1 UNABLE TO CREATE SITE PARAMETER RECORD" D ERRMSG Q
|
|---|
| 25 | S SPNLXREC=1000,SPNLXRUN=240,SPNLFREQ="1W"
|
|---|
| 26 | S SPNLSEEN="180D",SPNLEXAM="180D"
|
|---|
| 27 | S SPNLXMY="S.SPNN SCD MAIL RECEIVER@IPDB-CHICAGO.VA.GOV"
|
|---|
| 28 | S DR=".01///^S X=SPNLFAC;4///^S X=SPNLSEEN;5///^S X=SPNLEXAM"
|
|---|
| 29 | S DA=+Y,DIE="^SPNL(154.91," D ^DIE K DIE
|
|---|
| 30 | I $D(Y) S SPNLERR="2 UNABLE TO ADD DEFAULT SITE PARMETER VALUES" D ERRMSG Q
|
|---|
| 31 | Q
|
|---|
| 32 | EN2 ; Entry for Changing only the National Registry Destination
|
|---|
| 33 | I '$D(^SPNL(154.91,1,0)) D SETDEFS Q:SPNLERR
|
|---|
| 34 | S DA=1,DR="[SPNL SCD NATIONAL REGISTRY]",DIE="^SPNL(154.91," D ^DIE K DIE
|
|---|
| 35 | D END
|
|---|
| 36 | Q
|
|---|
| 37 | ERRMSG ;
|
|---|
| 38 | I $D(ZTQUEUED) G ERR2
|
|---|
| 39 | W !!,"SCD SITE PARAMETER FILE ERROR"
|
|---|
| 40 | W !!,"ERROR IS: ",$S(SPNLERR="":"SPNLERR IS NULL",SPNLERR'="":SPNLERR)
|
|---|
| 41 | Q
|
|---|
| 42 | ERR2 ;
|
|---|
| 43 | K X,% D NOW^%DTC S SPNLDT=%
|
|---|
| 44 | S XMSUB="SCD SITE PARAMETER ERROR",XMY("G.SPNL SCD COORDINATOR")=""
|
|---|
| 45 | S SPNLFAC=$P(^DIC(4,$P(^XMB(1,1,"XUS"),U,17),99),U,1),SPNLFAC=+$E(SPNLFAC,1,3)
|
|---|
| 46 | S SPNLFNAM=$P(^DIC(4,$P(^XMB(1,1,"XUS"),U,17),0),U,1)
|
|---|
| 47 | S SPNLTEXT(1)="H$ "_SPNLFAC_"^"_SPNLFNAM
|
|---|
| 48 | S SPNLTEXT(2)="E$ "_SPNLDT_"^"_SPNLERR
|
|---|
| 49 | S XMDUZ=.5,XMTEXT="SPNLTEXT("
|
|---|
| 50 | S:'$D(DTIME) DTIME=300 D ^XMD
|
|---|
| 51 | K XMDUZ,XMTEXT,XMSUB,XMY
|
|---|
| 52 | Q
|
|---|
| 53 | END ;
|
|---|
| 54 | K SPNLDT,SPNLEXAM,SPNLFAC,SPNLFNAM,SPNLFREQ,SPNLSEEN
|
|---|
| 55 | K SPNLTEXT,SPNLXMY,SPNLXREC,SPNLXRUN
|
|---|
| 56 | Q
|
|---|
