source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNLS.m@ 847

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