| 1 | DGPTAE ;ALB/MTC - Austin Edit Checks Driver ; 12 NOV 92
|
|---|
| 2 | ;;5.3;Registration;**58,415**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ; Check for 101, 501, 701; Route processing by type; call DRG and output routine
|
|---|
| 5 | EN ;
|
|---|
| 6 | N DGPTERP,DGPTERC,DGPRS,DGPTEDFL,DGPTNOW,DGPTFAC
|
|---|
| 7 | S (DGPTEDFL,DGPTERP)=0,DGPRS="N101^N501^N601^N701^N702^N703^N401^N402^N403^N535^"
|
|---|
| 8 | D NOW^%DTC S DGPTNOW=+X
|
|---|
| 9 | ;-- check if record available to process
|
|---|
| 10 | I '$D(^TMP("AEDIT")) G EXIT
|
|---|
| 11 | ;-- check if all nodes are present
|
|---|
| 12 | S DGPTERC=$$PRES() I DGPTERC D WRTERR(DGPTERC,"N101",1) G EXIT
|
|---|
| 13 | ;-- process record
|
|---|
| 14 | D ALLPR
|
|---|
| 15 | ;-- if errors
|
|---|
| 16 | D ERROR
|
|---|
| 17 | ;-- exit
|
|---|
| 18 | D EXIT
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | ALLPR ;-- process all records types
|
|---|
| 22 | N ERROR,NODE,SEQ
|
|---|
| 23 | S ERROR=0
|
|---|
| 24 | ;
|
|---|
| 25 | D FAC
|
|---|
| 26 | ;
|
|---|
| 27 | S NODE="" F S NODE=$O(^TMP("AEDIT",$J,NODE)) Q:NODE=""!(ERROR) D
|
|---|
| 28 | . S SEQ=0 F S SEQ=$O(^TMP("AEDIT",$J,NODE,SEQ)) Q:SEQ="" D RTE
|
|---|
| 29 | ;
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | EXIT ;-- clean-up
|
|---|
| 33 | K ^TMP("AEDIT",$J),^TMP("AERROR",$J),^TMP("AD",$J)
|
|---|
| 34 | K DGPTDTS,DGPTPS,DGPTSSN,DGPTDTA,DGPTFAC,DGPTLN,DGPTFI,DGPTMI
|
|---|
| 35 | K DGPTSRA,DGPTTF,DGPTSRP,DGPTPOW,DGPTMRS,DGPTGEN,DGPTDOB,DGPTPOS1,DGPTPOS2,DGPTEXA,DGPTEXI,DGPTSTE,DGPTCTY,DGPTZIP,DGPTMTC,DGPTBY,DGPTINC
|
|---|
| 36 | K DGPTDDTD,DGPTDDS,DGPTDSP,DGPTDTY,DGPTDOP,DGPTDVA,DGPTDPD,DGPTDRF,DGPTDAS,DGPTDCP,DGPTDDXE,DGPTDDXO,DGPTDLR,DGPTDLC,DGPTDSC
|
|---|
| 37 | K DGPT70LG,DGPT70SU,DGPT70DR,DGPT70X4,DGPTDXV1,DGPTDXV2
|
|---|
| 38 | K DGPTMSR,DGPTMSC,DGPTMLD,DGPTMPD,DGPTMSI,DGPTMD1,DGPTMD11,DGPTMD2,DGPTMD3,DGPTMD4,DGPTMD5,DGPTMXX,DGPTMLR,DGPTMLC,DGPTMBS
|
|---|
| 39 | K DGPTMLG,DGPTMSU,DGPTMDG,DGPTMXIV,DGPTMXV1,DGPTMXV2,DGPT50SR
|
|---|
| 40 | K DGACNT,DGPT7X51,DGPT7X52,DGPTADT,DGPTAGE,DGPTAL7,DGPTBYR,DGPTDIA,DGPTDIA1,DGPTDIA2,DGPTDIAR,DGPTELP,DGPTFEF,DGPTFMDB,DGPTGEN1,DGPTL3,DGPTL4,DGPTMSX,DGPTS1,DGPTS2,DGPTSTTY,DGPTTY,DGPTXTTY,DGSCDT,DGPTPRAR,DGPTOPAR,DGSCDT,DGPTOC
|
|---|
| 41 | K DGFNUM,DGLAST,DGMVT,DGOUT,DGPTF,DGPTOPP,DGSCDT,DGSPEC,DGLAST,DGFNUM
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | RTE ;route processing
|
|---|
| 45 | N DGFL2,I,J
|
|---|
| 46 | S DGFL2=0 F I=1:1:9 S:NODE=$P(DGPRS,U,I) DGFL2=1 Q:(DGFL2)!($P(DGPRS,U,I)']"")
|
|---|
| 47 | I 'DGFL2 S ERROR=101 Q
|
|---|
| 48 | Q:NODE="N701"
|
|---|
| 49 | ;
|
|---|
| 50 | D @("^DGPT"_$S($E(NODE,2)=4:"401",1:$E(NODE,2,4)))
|
|---|
| 51 | RTN ;
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | PRES() ;-- check if required pieces are present
|
|---|
| 55 | N I,ERROR
|
|---|
| 56 | S ERROR=0
|
|---|
| 57 | F I="N101","N501","N701" I '$D(^TMP("AEDIT",$J,I)) S ERROR=188 Q
|
|---|
| 58 | Q ERROR
|
|---|
| 59 | ;
|
|---|
| 60 | WRTERR(ERROR,NODE,SEQ) ;-- This function will write out errors to the ^TMP("AERROR"
|
|---|
| 61 | ; global.
|
|---|
| 62 | ; INPUT : ERROR - code of Austin's error
|
|---|
| 63 | ; NODE - node error occured on
|
|---|
| 64 | ; SEQ - sequence in ^TMP("AEDIT",
|
|---|
| 65 | ;
|
|---|
| 66 | I '$D(ERROR) G WRTQ
|
|---|
| 67 | S DGPTERP=DGPTERP+1,^TMP("AERROR",$J,SEQ,NODE,DGPTERP)=ERROR
|
|---|
| 68 | I DGPTERP>12 S DGPTEDFL=1
|
|---|
| 69 | WRTQ Q
|
|---|
| 70 | ;
|
|---|
| 71 | FAC ;-- check facility id; get station type
|
|---|
| 72 | N SUFFIX,SOA,STATION,STTY
|
|---|
| 73 | S DGPTSTTY="",X=$G(^TMP("AEDIT",$J,"N101",1)),DGPTFAC=$E(X,25,30),SUFFIX=$E(X,29,30),SOA=$E(X,45,46)
|
|---|
| 74 | I SOA=" " D WRTERR(107) G FACQ
|
|---|
| 75 | I DGPTFAC'=" ",'DGPTFAC D WRTERR(108,"101") G FACQ
|
|---|
| 76 | I SUFFIX]"" I $D(^DIC(45.81,"D1",SUFFIX)) S DGPTSTTY=$O(^(SUFFIX,0)) S:DGPTSTTY DGPTSTTY=U_DGPTSTTY_U
|
|---|
| 77 | S X=$O(^DIC(45.1,"B",$E(X,45,46),0))
|
|---|
| 78 | S STATION="",STTY=0 F S STTY=$O(^DIC(45.1,X,"ST",STTY)) Q:'STTY S STATION=STATION_"^"_STTY
|
|---|
| 79 | S STATION=STATION_"^"
|
|---|
| 80 | I $P(DGPTSTTY,U,2),STATION'[DGPTSTTY D WRTERR(135,"101") G FACQ
|
|---|
| 81 | S DGPTSTTY=STATION
|
|---|
| 82 | FACQ Q
|
|---|
| 83 | ;
|
|---|
| 84 | ERROR ;-- this routine will process the error detected during close-out
|
|---|
| 85 | G:'$D(^TMP("AERROR",$J)) ERRQ
|
|---|
| 86 | S DGERR=1
|
|---|
| 87 | D EN^VALM("DGPT CLOSE-OUT ERROR")
|
|---|
| 88 | ERRQ Q
|
|---|
| 89 | ;
|
|---|
