[613] | 1 | SPNLS ;ISC-SF/RAH - EXTRACT CONTROL FOR LOCAL TO NATIONAL ;8/31/95 14:13
|
---|
| 2 | V ;;2.0;Spinal Cord Dysfunction;**2**;01/02/1997
|
---|
| 3 | EN ;
|
---|
| 4 | K ^TMP("SPNX",$J),^TMP("SPNLS",$J),^TMP("SPNXMRK",$J)
|
---|
| 5 | S (SPNLERR,SPNLLOC,SPNLFULL,SPNLHDR,SPNLPTS)=""
|
---|
| 6 | S (SPNLH,SPNLPCNT,SPNLTMP)=0,SPNLCTXT=1
|
---|
| 7 | CKR ;
|
---|
| 8 | ;I '$D(ZTQUEUED) D SETVARS,EN1^SPNLSCH Q
|
---|
| 9 | MAINLIN ;
|
---|
| 10 | D INIT^SPNLGE(.SPNLERR)
|
---|
| 11 | D SETVARS
|
---|
| 12 | I SPNLERR D ERRMSG Q
|
---|
| 13 | D CALCSTOP
|
---|
| 14 | D LOOP ; Loop thru Registry
|
---|
| 15 | D SNDMAIL
|
---|
| 16 | D ^SPNLS1 ; Update control files and re-schedule
|
---|
| 17 | D END
|
---|
| 18 | Q
|
---|
| 19 | LOOP ;
|
---|
| 20 | S SPNLPID=SPNSTRID
|
---|
| 21 | F S SPNLPID=$O(^SPNL(154,SPNLPID)) Q:SPNLPID'>0 D Q:SPNLH>SPNLSTP
|
---|
| 22 | .S SPNLLID=SPNLPID,SPNLH1=$P($H,",",1),SPNLH2=$P($H,",",2),SPNLH=SPNLH1_"."_SPNLH2
|
---|
| 23 | .I $P($G(^SPNL(154,SPNLPID,0)),U,3,4)'="1^T" Q ; Active & Transmit
|
---|
| 24 | .I '$P($G(^SPNL(154,SPNLPID,"XMT")),U),'$$CK1541(SPNLPID) Q ; Any Changes to Record
|
---|
| 25 | .S SPNLPTS="",SPNLERR=""
|
---|
| 26 | .S:$D(^SPNL(154.9,SPNLPID,0)) SPNLPTS=^SPNL(154.9,SPNLPID,0)
|
---|
| 27 | .I SPNLPTS="" S SPNLPTS=SPNLPID_U_U D CRATEREC Q:SPNLERR
|
---|
| 28 | .I $P(SPNLPTS,U,2)="" S $P(SPNLPTS,U,2)="1000100"
|
---|
| 29 | .I $P(SPNLPTS,U,3)="" S $P(SPNLPTS,U,3)="1000100"
|
---|
| 30 | .S SPNLFDT=$E($P(SPNLPTS,U,3),1,5)_"01",SPNLTDT=SPNLSDT
|
---|
| 31 | .S SPNLERR="" D EXTRACT^SPNLGE(SPNLPID,SPNLFDT,SPNLTDT,SPNLCTXT,.SPNLERR)
|
---|
| 32 | .I SPNLERR D ERRMSG Q
|
---|
| 33 | .S SPNLPCNT=SPNLPCNT+1
|
---|
| 34 | .S ^TMP("SPNLS",$J,SPNLPID)=SPNLPID_U_SPNLFDT_U_SPNLTDT
|
---|
| 35 | .Q
|
---|
| 36 | I SPNLPID'>0 S SPNLFULL=1,SPNLPID=1
|
---|
| 37 | I 'SPNLFULL S SPNLTYPE="PARTIAL"
|
---|
| 38 | Q
|
---|
| 39 | CK1541(DFN) ; Check the 154.1 globle for a entry CAN be sent.
|
---|
| 40 | N SPNLFLG,SPNLIEN
|
---|
| 41 | S (SPNLFLG,SPNLIEN)=0
|
---|
| 42 | F S SPNLIEN=$O(^SPNL(154.1,"B",DFN,SPNLIEN)) Q:SPNLIEN<1 D Q:SPNLFLG
|
---|
| 43 | . Q:$G(^SPNL(154.1,SPNLIEN,0))="" ; Bad zero node
|
---|
| 44 | . S SPNLFLG=+$P($G(^SPNL(154.1,SPNLIEN,"XMT")),U) ; send OR not to send.
|
---|
| 45 | . Q
|
---|
| 46 | Q SPNLFLG
|
---|
| 47 | CRATEREC ;
|
---|
| 48 | K DD,DIC,DINUM,DO
|
---|
| 49 | S DIC(0)="LMN",DIC="^SPNL(154.9,",X=SPNLPID,DINUM=SPNLPID,DLAYGO=154.9
|
---|
| 50 | D FILE^DICN K DIC,DINUM
|
---|
| 51 | I Y=-1 S SPNLERR="1 COULD NOT MAKE ENTRY "_SPNLPID_" IN PTN TX FILE" D ERRMSG Q
|
---|
| 52 | S SPNLPIEN=$P(Y,U,1)
|
---|
| 53 | Q
|
---|
| 54 | PTXIEN ;
|
---|
| 55 | S DIC(0)="MNO",DIC="^SPNL(154.9,",X=SPNLPID D ^DIC K DIC
|
---|
| 56 | I Y=-1 S SPNLERR="3 COULD NOT FIND ENTRY "_SPNLPID_" IN PTN TX FILE" D ERRMSG Q
|
---|
| 57 | S SPNLPIEN=$P(Y,U,1)
|
---|
| 58 | Q
|
---|
| 59 | SETVARS ;
|
---|
| 60 | S SPNLTMP=.9
|
---|
| 61 | S SPNLTMP=$O(^SPNL(154.93,SPNLTMP))
|
---|
| 62 | I SPNLTMP="" D
|
---|
| 63 | .S SPNLTMP=1 K DD,DIC,DINUM,DO
|
---|
| 64 | .S DIC(0)="LMN",DIC="^SPNL(154.93,",X=1,DINUM=1,DLAYGO=154.93
|
---|
| 65 | .D FILE^DICN K DIC
|
---|
| 66 | .S ^SPNL(154.93,1,0)="1^^^^^FULL^0^0^1"
|
---|
| 67 | S SPNLTXCY=^SPNL(154.93,SPNLTMP,0)
|
---|
| 68 | I $P(SPNLTXCY,U,10)="" S $P(SPNLTXCY,U,10)=0
|
---|
| 69 | I $P(SPNLTXCY,U,6)="" S $P(SPNLTXCY,U,7)="FULL"
|
---|
| 70 | S SPNLCYNO=$P(SPNLTXCY,U,1),SPNLTIME=$P(SPNLTXCY,U,10),SPNLCYST=$P(SPNLTXCY,U,2)
|
---|
| 71 | I $D(^SPNL(154.91,1,0)) S SPNPARMS=^SPNL(154.91,1,0)
|
---|
| 72 | E S SPNPARMS="^1000^240^1W"
|
---|
| 73 | I $P(SPNPARMS,U,2)="" S $P(SPNPARMS,U,2)=1000
|
---|
| 74 | I $P(SPNPARMS,U,3)="" S $P(SPNPARMS,U,3,4)="240^1W"
|
---|
| 75 | S SPNXRECS=$P(SPNPARMS,U,2),SPNXRUN=$P(SPNPARMS,U,3)
|
---|
| 76 | S SPNSTRID=$P(SPNLTXCY,U,10),SPNLTYPE=$P(SPNLTXCY,U,6)
|
---|
| 77 | S SPNLFREQ=$P(SPNPARMS,U,4)
|
---|
| 78 | S SPNLLOC="^TMP(""SPNX"",$J,"
|
---|
| 79 | K X,% D NOW^%DTC S SPNLSDT=X,SPNLSDAT=%,SPNLSTRT=%
|
---|
| 80 | S SPNLFAC=$P(^SPNL(154.91,1,0),U,1)
|
---|
| 81 | S SPNLXMY=$P(^SPNL(154.91,1,0),U,7)
|
---|
| 82 | S SPNLFNAM=$P(^DIC(4,$P(^XMB(1,1,"XUS"),U,17),0),U,1)
|
---|
| 83 | S SPNLNODE=SPNLFNAM_U_SPNXRUN_U_SPNLFREQ_U_SPNLCYST_U_U_SPNLTYPE_U_SPNLSDAT_U_U
|
---|
| 84 | S ^TMP("SPNX",$J,SPNLSDT,SPNLFAC)=SPNLNODE
|
---|
| 85 | SETHDR ;
|
---|
| 86 | S SPNLHDR="SCD"_U_SPNLFAC_U_SPNLSDT_U_SPNLTYPE_U_SPNLCYNO_U_SPNXRECS_U_SPNXRUN_U_SPNLTIME_U_"1.5"
|
---|
| 87 | S SPNLSUB="SCD"_"$"_SPNLFAC_"$"_"SPINAL CORD"_"$"_SPNLSDT
|
---|
| 88 | Q
|
---|
| 89 | CALCSTOP ;
|
---|
| 90 | S SPNLDAYS=$P($H,",",1),SPNLSEC=$P($H,",",2),SPNLSEC=SPNLSEC+(SPNXRUN*60)
|
---|
| 91 | I SPNLSEC>86399 D
|
---|
| 92 | .F S SPNLDAYS=SPNLDAYS+1,SPNLSEC=SPNLSEC-86400 Q:SPNLSEC<86400
|
---|
| 93 | S SPNLSTP=SPNLDAYS_"."_SPNLSEC
|
---|
| 94 | Q
|
---|
| 95 | SNDMAIL ;
|
---|
| 96 | D EN1^SPNLXMD(SPNLLOC,SPNLSUB,SPNLXMY,.SPNLERR)
|
---|
| 97 | I SPNLERR D ERRMSG
|
---|
| 98 | Q
|
---|
| 99 | ERRMSG ;
|
---|
| 100 | K X,% D NOW^%DTC S SPNLDT=%
|
---|
| 101 | S XMSUB=$S(+SPNLERR=4:"SCD REGISTRY EXTRACT MESSAGE",1:"SCD REGISTRY EXTRACT ERROR")
|
---|
| 102 | S XMY("G.SPNL SCD COORDINATOR")=""
|
---|
| 103 | S SPNLFAC=$P(^DIC(4,$P(^XMB(1,1,"XUS"),U,17),99),U,1),SPNLFAC=+$E(SPNLFAC,1,3)
|
---|
| 104 | S SPNLFNAM=$P(^DIC(4,$P(^XMB(1,1,"XUS"),U,17),0),U,1)
|
---|
| 105 | S SPNLTEXT(1)="H$ "_SPNLDT_"^"_SPNLFAC_"^"_SPNLFNAM
|
---|
| 106 | S SPNLTEXT(2)="I$ "_SPNLPID_"^"_SPNLHDR
|
---|
| 107 | S SPNLTEXT(3)="P$ "_SPNPARMS
|
---|
| 108 | S SPNLTEXT(4)="C$ "_SPNLTXCY
|
---|
| 109 | S SPNLTEXT(5)="E$ "_SPNLERR
|
---|
| 110 | S XMDUZ=.5,XMTEXT="SPNLTEXT("
|
---|
| 111 | S:'$D(DTIME) DTIME=300 D ^XMD
|
---|
| 112 | Q
|
---|
| 113 | END ;
|
---|
| 114 | D DIE^SPNLRU1
|
---|
| 115 | K SPNLCT,SPNLCTXT,SPNLCYNO,SPNLCYST,SPNLDAYS,SPNLERR,SPNLFAC,SPNLFNAM
|
---|
| 116 | K SPNLFREQ,SPNLFULL,SPNLHDR,SPNLLID,SPNLLOC,SPNLMOS,SPNLNODE,SPNLPCNT
|
---|
| 117 | K SPNLPID,SPNLPTS,SPNLSDAT,SPNLSDT,SPNLSEC,SPNLSSN,SPNLSTP,SPNLSUB
|
---|
| 118 | K SPNLT,SPNLTIME,SPNLTXCY,SPNLTYPE,SPNLXMY,SPNLYRS,SPNPARMS,SPNSTRID
|
---|
| 119 | K SPNXRECS,SPNXRUN,ZTRTN,ZTDTH,ZTIO,ZTSK,ZTDESC
|
---|
| 120 | K SPNLDT,SPNLFDT,SPNLTDT,SPNLH,SPNLH1,SPNLH2,SPNLPIEN,SPNLSTRT,SPNLTEXT
|
---|
| 121 | K ^TMP("SPNX",$J),^TMP("SPNLS",$J),^TMP("SPNXMRK",$J)
|
---|
| 122 | Q
|
---|