123 lines
4.6 KiB
Mathematica
123 lines
4.6 KiB
Mathematica
SPNLS ;ISC-SF/RAH - EXTRACT CONTROL FOR LOCAL TO NATIONAL ;8/31/95 14:13
|
|
V ;;2.0;Spinal Cord Dysfunction;**2**;01/02/1997
|
|
EN ;
|
|
K ^TMP("SPNX",$J),^TMP("SPNLS",$J),^TMP("SPNXMRK",$J)
|
|
S (SPNLERR,SPNLLOC,SPNLFULL,SPNLHDR,SPNLPTS)=""
|
|
S (SPNLH,SPNLPCNT,SPNLTMP)=0,SPNLCTXT=1
|
|
CKR ;
|
|
;I '$D(ZTQUEUED) D SETVARS,EN1^SPNLSCH Q
|
|
MAINLIN ;
|
|
D INIT^SPNLGE(.SPNLERR)
|
|
D SETVARS
|
|
I SPNLERR D ERRMSG Q
|
|
D CALCSTOP
|
|
D LOOP ; Loop thru Registry
|
|
D SNDMAIL
|
|
D ^SPNLS1 ; Update control files and re-schedule
|
|
D END
|
|
Q
|
|
LOOP ;
|
|
S SPNLPID=SPNSTRID
|
|
F S SPNLPID=$O(^SPNL(154,SPNLPID)) Q:SPNLPID'>0 D Q:SPNLH>SPNLSTP
|
|
.S SPNLLID=SPNLPID,SPNLH1=$P($H,",",1),SPNLH2=$P($H,",",2),SPNLH=SPNLH1_"."_SPNLH2
|
|
.I $P($G(^SPNL(154,SPNLPID,0)),U,3,4)'="1^T" Q ; Active & Transmit
|
|
.I '$P($G(^SPNL(154,SPNLPID,"XMT")),U),'$$CK1541(SPNLPID) Q ; Any Changes to Record
|
|
.S SPNLPTS="",SPNLERR=""
|
|
.S:$D(^SPNL(154.9,SPNLPID,0)) SPNLPTS=^SPNL(154.9,SPNLPID,0)
|
|
.I SPNLPTS="" S SPNLPTS=SPNLPID_U_U D CRATEREC Q:SPNLERR
|
|
.I $P(SPNLPTS,U,2)="" S $P(SPNLPTS,U,2)="1000100"
|
|
.I $P(SPNLPTS,U,3)="" S $P(SPNLPTS,U,3)="1000100"
|
|
.S SPNLFDT=$E($P(SPNLPTS,U,3),1,5)_"01",SPNLTDT=SPNLSDT
|
|
.S SPNLERR="" D EXTRACT^SPNLGE(SPNLPID,SPNLFDT,SPNLTDT,SPNLCTXT,.SPNLERR)
|
|
.I SPNLERR D ERRMSG Q
|
|
.S SPNLPCNT=SPNLPCNT+1
|
|
.S ^TMP("SPNLS",$J,SPNLPID)=SPNLPID_U_SPNLFDT_U_SPNLTDT
|
|
.Q
|
|
I SPNLPID'>0 S SPNLFULL=1,SPNLPID=1
|
|
I 'SPNLFULL S SPNLTYPE="PARTIAL"
|
|
Q
|
|
CK1541(DFN) ; Check the 154.1 globle for a entry CAN be sent.
|
|
N SPNLFLG,SPNLIEN
|
|
S (SPNLFLG,SPNLIEN)=0
|
|
F S SPNLIEN=$O(^SPNL(154.1,"B",DFN,SPNLIEN)) Q:SPNLIEN<1 D Q:SPNLFLG
|
|
. Q:$G(^SPNL(154.1,SPNLIEN,0))="" ; Bad zero node
|
|
. S SPNLFLG=+$P($G(^SPNL(154.1,SPNLIEN,"XMT")),U) ; send OR not to send.
|
|
. Q
|
|
Q SPNLFLG
|
|
CRATEREC ;
|
|
K DD,DIC,DINUM,DO
|
|
S DIC(0)="LMN",DIC="^SPNL(154.9,",X=SPNLPID,DINUM=SPNLPID,DLAYGO=154.9
|
|
D FILE^DICN K DIC,DINUM
|
|
I Y=-1 S SPNLERR="1 COULD NOT MAKE ENTRY "_SPNLPID_" IN PTN TX FILE" D ERRMSG Q
|
|
S SPNLPIEN=$P(Y,U,1)
|
|
Q
|
|
PTXIEN ;
|
|
S DIC(0)="MNO",DIC="^SPNL(154.9,",X=SPNLPID D ^DIC K DIC
|
|
I Y=-1 S SPNLERR="3 COULD NOT FIND ENTRY "_SPNLPID_" IN PTN TX FILE" D ERRMSG Q
|
|
S SPNLPIEN=$P(Y,U,1)
|
|
Q
|
|
SETVARS ;
|
|
S SPNLTMP=.9
|
|
S SPNLTMP=$O(^SPNL(154.93,SPNLTMP))
|
|
I SPNLTMP="" D
|
|
.S SPNLTMP=1 K DD,DIC,DINUM,DO
|
|
.S DIC(0)="LMN",DIC="^SPNL(154.93,",X=1,DINUM=1,DLAYGO=154.93
|
|
.D FILE^DICN K DIC
|
|
.S ^SPNL(154.93,1,0)="1^^^^^FULL^0^0^1"
|
|
S SPNLTXCY=^SPNL(154.93,SPNLTMP,0)
|
|
I $P(SPNLTXCY,U,10)="" S $P(SPNLTXCY,U,10)=0
|
|
I $P(SPNLTXCY,U,6)="" S $P(SPNLTXCY,U,7)="FULL"
|
|
S SPNLCYNO=$P(SPNLTXCY,U,1),SPNLTIME=$P(SPNLTXCY,U,10),SPNLCYST=$P(SPNLTXCY,U,2)
|
|
I $D(^SPNL(154.91,1,0)) S SPNPARMS=^SPNL(154.91,1,0)
|
|
E S SPNPARMS="^1000^240^1W"
|
|
I $P(SPNPARMS,U,2)="" S $P(SPNPARMS,U,2)=1000
|
|
I $P(SPNPARMS,U,3)="" S $P(SPNPARMS,U,3,4)="240^1W"
|
|
S SPNXRECS=$P(SPNPARMS,U,2),SPNXRUN=$P(SPNPARMS,U,3)
|
|
S SPNSTRID=$P(SPNLTXCY,U,10),SPNLTYPE=$P(SPNLTXCY,U,6)
|
|
S SPNLFREQ=$P(SPNPARMS,U,4)
|
|
S SPNLLOC="^TMP(""SPNX"",$J,"
|
|
K X,% D NOW^%DTC S SPNLSDT=X,SPNLSDAT=%,SPNLSTRT=%
|
|
S SPNLFAC=$P(^SPNL(154.91,1,0),U,1)
|
|
S SPNLXMY=$P(^SPNL(154.91,1,0),U,7)
|
|
S SPNLFNAM=$P(^DIC(4,$P(^XMB(1,1,"XUS"),U,17),0),U,1)
|
|
S SPNLNODE=SPNLFNAM_U_SPNXRUN_U_SPNLFREQ_U_SPNLCYST_U_U_SPNLTYPE_U_SPNLSDAT_U_U
|
|
S ^TMP("SPNX",$J,SPNLSDT,SPNLFAC)=SPNLNODE
|
|
SETHDR ;
|
|
S SPNLHDR="SCD"_U_SPNLFAC_U_SPNLSDT_U_SPNLTYPE_U_SPNLCYNO_U_SPNXRECS_U_SPNXRUN_U_SPNLTIME_U_"1.5"
|
|
S SPNLSUB="SCD"_"$"_SPNLFAC_"$"_"SPINAL CORD"_"$"_SPNLSDT
|
|
Q
|
|
CALCSTOP ;
|
|
S SPNLDAYS=$P($H,",",1),SPNLSEC=$P($H,",",2),SPNLSEC=SPNLSEC+(SPNXRUN*60)
|
|
I SPNLSEC>86399 D
|
|
.F S SPNLDAYS=SPNLDAYS+1,SPNLSEC=SPNLSEC-86400 Q:SPNLSEC<86400
|
|
S SPNLSTP=SPNLDAYS_"."_SPNLSEC
|
|
Q
|
|
SNDMAIL ;
|
|
D EN1^SPNLXMD(SPNLLOC,SPNLSUB,SPNLXMY,.SPNLERR)
|
|
I SPNLERR D ERRMSG
|
|
Q
|
|
ERRMSG ;
|
|
K X,% D NOW^%DTC S SPNLDT=%
|
|
S XMSUB=$S(+SPNLERR=4:"SCD REGISTRY EXTRACT MESSAGE",1:"SCD REGISTRY EXTRACT ERROR")
|
|
S XMY("G.SPNL SCD COORDINATOR")=""
|
|
S SPNLFAC=$P(^DIC(4,$P(^XMB(1,1,"XUS"),U,17),99),U,1),SPNLFAC=+$E(SPNLFAC,1,3)
|
|
S SPNLFNAM=$P(^DIC(4,$P(^XMB(1,1,"XUS"),U,17),0),U,1)
|
|
S SPNLTEXT(1)="H$ "_SPNLDT_"^"_SPNLFAC_"^"_SPNLFNAM
|
|
S SPNLTEXT(2)="I$ "_SPNLPID_"^"_SPNLHDR
|
|
S SPNLTEXT(3)="P$ "_SPNPARMS
|
|
S SPNLTEXT(4)="C$ "_SPNLTXCY
|
|
S SPNLTEXT(5)="E$ "_SPNLERR
|
|
S XMDUZ=.5,XMTEXT="SPNLTEXT("
|
|
S:'$D(DTIME) DTIME=300 D ^XMD
|
|
Q
|
|
END ;
|
|
D DIE^SPNLRU1
|
|
K SPNLCT,SPNLCTXT,SPNLCYNO,SPNLCYST,SPNLDAYS,SPNLERR,SPNLFAC,SPNLFNAM
|
|
K SPNLFREQ,SPNLFULL,SPNLHDR,SPNLLID,SPNLLOC,SPNLMOS,SPNLNODE,SPNLPCNT
|
|
K SPNLPID,SPNLPTS,SPNLSDAT,SPNLSDT,SPNLSEC,SPNLSSN,SPNLSTP,SPNLSUB
|
|
K SPNLT,SPNLTIME,SPNLTXCY,SPNLTYPE,SPNLXMY,SPNLYRS,SPNPARMS,SPNSTRID
|
|
K SPNXRECS,SPNXRUN,ZTRTN,ZTDTH,ZTIO,ZTSK,ZTDESC
|
|
K SPNLDT,SPNLFDT,SPNLTDT,SPNLH,SPNLH1,SPNLH2,SPNLPIEN,SPNLSTRT,SPNLTEXT
|
|
K ^TMP("SPNX",$J),^TMP("SPNLS",$J),^TMP("SPNXMRK",$J)
|
|
Q
|