Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPTAE

DGPTAE.m

Go to the documentation of this file.
  1. DGPTAE ;ALB/MTC,HIOFO/FT - Austin Edit Checks Driver ;4/8/15 11:23am
  1. ;;5.3;Registration;**58,415,884**;Aug 13, 1993;Build 31
  1. ;
  1. ; VALM APIs - #10118
  1. ;
  1. ; Check for 101, 501, 701; Route processing by type; call DRG and output routine
  1. EN ;
  1. N DGPTERP,DGPTERC,DGPRS,DGPTEDFL,DGPTNOW,DGPTFAC
  1. S (DGPTEDFL,DGPTERP)=0,DGPRS="N101^N501^N601^N701^N702^N703^N401^N402^N403^N535^"
  1. D NOW^%DTC S DGPTNOW=+X
  1. ;-- check if record available to process
  1. I '$D(^TMP("AEDIT")) G EXIT
  1. ;-- check if all nodes are present
  1. S DGPTERC=$$PRES() I DGPTERC D WRTERR(DGPTERC,"N101",1) G EXIT
  1. ;-- process record
  1. D ALLPR
  1. ;-- if errors
  1. D ERROR
  1. ;-- exit
  1. D EXIT
  1. Q
  1. ;
  1. ALLPR ;-- process all records types
  1. N ERROR,NODE,SEQ
  1. S ERROR=0
  1. ;
  1. D FAC
  1. ;
  1. S NODE="" F S NODE=$O(^TMP("AEDIT",$J,NODE)) Q:NODE=""!(ERROR) D
  1. . S SEQ=0 F S SEQ=$O(^TMP("AEDIT",$J,NODE,SEQ)) Q:SEQ="" D RTE
  1. ;
  1. Q
  1. ;
  1. EXIT ;-- clean-up
  1. K ^TMP("AEDIT",$J),^TMP("AERROR",$J),^TMP("AD",$J)
  1. K DGPTDTS,DGPTPS,DGPTSSN,DGPTDTA,DGPTFAC,DGPTLN,DGPTFI,DGPTMI
  1. K DGPTSRA,DGPTTF,DGPTSRP,DGPTPOW,DGPTMRS,DGPTGEN,DGPTDOB,DGPTPOS1,DGPTPOS2,DGPTEXA,DGPTEXI,DGPTSTE,DGPTCTY,DGPTZIP,DGPTMTC,DGPTBY,DGPTINC
  1. K DGPTDDTD,DGPTDDS,DGPTDSP,DGPTDTY,DGPTDOP,DGPTDVA,DGPTDPD,DGPTDRF,DGPTDAS,DGPTDCP,DGPTDDXE,DGPTDDXO,DGPTDLR,DGPTDLC,DGPTDSC
  1. K DGPT70LG,DGPT70SU,DGPT70DR,DGPT70X4,DGPTDXV1,DGPTDXV2,DGPT70AO,DGPT70COMVET,DGPT70ETHNIC,DGPT70HNC,DGPT70IR,DGPT70MST,DGPTTOD,DGPTDOD
  1. K DGPTMSR,DGPTMSC,DGPTMLD,DGPTMPD,DGPTMSI,DGPTMD1,DGPTMD11,DGPTMD2,DGPTMD3,DGPTMD4,DGPTMD5,DGPTMXX,DGPTMLR,DGPTMLC,DGPTMBS
  1. K DGPTMLG,DGPTMSU,DGPTMDG,DGPTMXIV,DGPTMXV1,DGPTMXV2,DGPT50SR,DGPT70RACE,DGPT70RACE1,DGPT70RACE2,DGPT70RACE3,DGPT70RACE4,DGPT70RACE5,DGPT70RACE6
  1. 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
  1. K DGFNUM,DGLAST,DGMVT,DGOUT,DGPTF,DGPTOPP,DGSCDT,DGSPEC,DGLAST,DGFNUM,DGPT70SHAD,DGPT70SWA,DGPT70TSC,DGPTOD,DGPTDXLSPOA,DGPTGD1
  1. K DGPTMPOA1,DGPTMPOA10,DGPTMPOA11,DGPTMPOA12,DGPTMPOA13,DGPTMPOA14,DGPTMPOA15,DGPTMPOA16,DGPTMPOA17,DGPTMPOA18,DGPTMPOA19,DGPTMPOA2
  1. K DGPTMPOA20,DGPTMPOA21,DGPTMPOA22,DGPTMPOA23,DGPTMPOA24,DGPTMPOA25,DGPTMPOA3,DGPTMPOA4,DGPTMPOA5,DGPTMPOA6,DGPTMPOA7,DGPTMPOA8,DGPTMPOA9
  1. Q
  1. ;
  1. RTE ;route processing
  1. N DGFL2,I,J
  1. S DGFL2=0 F I=1:1:10 S:NODE=$P(DGPRS,U,I) DGFL2=1 Q:(DGFL2)!($P(DGPRS,U,I)']"")
  1. I 'DGFL2 S ERROR=101 Q
  1. Q:NODE="N701"
  1. ;
  1. D @("^DGPT"_$S($E(NODE,2)=4:"401",1:$E(NODE,2,4)))
  1. RTN ;
  1. Q
  1. ;
  1. PRES() ;-- check if required pieces are present
  1. N I,ERROR
  1. S ERROR=0
  1. F I="N101","N501","N701" I '$D(^TMP("AEDIT",$J,I)) S ERROR=188 Q
  1. Q ERROR
  1. ;
  1. WRTERR(ERROR,NODE,SEQ) ;-- This function will write out errors to the ^TMP("AERROR"
  1. ; global.
  1. ; INPUT : ERROR - code of Austin's error
  1. ; NODE - node error occurred on
  1. ; SEQ - sequence in ^TMP("AEDIT",
  1. ;
  1. I '$D(ERROR) G WRTQ
  1. S DGPTERP=DGPTERP+1,^TMP("AERROR",$J,SEQ,NODE,DGPTERP)=ERROR
  1. I DGPTERP>12 S DGPTEDFL=1
  1. WRTQ Q
  1. ;
  1. FAC ;-- check facility id; get station type
  1. N SUFFIX,SOA,STATION,STTY
  1. S DGPTSTTY="",X=$G(^TMP("AEDIT",$J,"N101",1)),DGPTFAC=$E(X,25,30),SUFFIX=$E(X,29,30),SOA=$E(X,45,46)
  1. I SOA=" " D WRTERR(107) G FACQ
  1. I DGPTFAC'=" ",'DGPTFAC D WRTERR(108,"101") G FACQ
  1. I SUFFIX]"" I $D(^DIC(45.81,"D1",SUFFIX)) S DGPTSTTY=$O(^(SUFFIX,0)) S:DGPTSTTY DGPTSTTY=U_DGPTSTTY_U
  1. S X=$O(^DIC(45.1,"B",$E(X,45,46),0))
  1. S STATION="",STTY=0 F S STTY=$O(^DIC(45.1,X,"ST",STTY)) Q:'STTY S STATION=STATION_"^"_STTY
  1. S STATION=STATION_"^"
  1. I $P(DGPTSTTY,U,2),STATION'[DGPTSTTY D WRTERR(135,"101") G FACQ
  1. S DGPTSTTY=STATION
  1. FACQ Q
  1. ;
  1. ERROR ;-- this routine will process the error detected during close-out
  1. G:'$D(^TMP("AERROR",$J)) ERRQ
  1. S DGERR=1
  1. D EN^VALM("DGPT CLOSE-OUT ERROR")
  1. ERRQ Q
  1. ;