source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPT535.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1DGPT535 ;ALB/MTC - Process 535 transmission ; 16 NOV 92
2 ;;5.3;Registration;**64,164,729**;Aug 13, 1993;Build 59
3 ;
4EN ;
5 S DGPTSTR=^TMP("AEDIT",$J,NODE,SEQ),DGPTEDFL=0
6 S DGPTTDT=$E(DGPTSTR,31,40),(X,DGPTTDTS)=$$FMDT^DGPT101($E(DGPTTDT,1,6))_"."_$E(DGPTTDT,7,10) S %DT="XT" D ^%DT I Y<0 S DGPTERC=505 D ERR G:DGPTEDFL EXIT G SET
7 D DD^%DT S DGPTTDT=$E(Y,5,6)_"-"_$E(Y,1,3)_"-"_$E(Y,8,11)_" "_$S($P(Y,"@",2)]"":$E($P(Y,"@",2),1,5),1:"00:00")
8SET ;
9 S DGPTTLR=$E(DGPTSTR,41,46),DGPTTLC=$E(DGPTSTR,47,48),DGPTTSR=$E(DGPTSTR,49,54),DGPTTSC=$E(DGPTSTR,55,56),DGPTTLD=$E(DGPTSTR,57,59),DGPTTPD=$E(DGPTSTR,60,62),DGPTXX=$E(DGPTSTR,63,71)
10DTE ;
11 S DGPTTDDS=$$FMDT^DGPT101($E(DGPTSTR,31,36))_"."_$E(DGPTSTR,37,40)
12 I (DGPTTDDS'>DGPTDTS)!(DGPTTDDS'<DGPTDDS) S DGPTERC=540 D ERR G:DGPTEDFL EXIT
13TSPEC ;
14 N DGPTTSC1
15 I DGPTTSC'?2AN S DGPTERC=506 D ERR G:DGPTEDFL EXIT
16 S DGPTSP1=$E(DGPTTSC,1),DGPTSP2=$E(DGPTTSC,2),DGPTERC=0
17 D CHECK^DGPTAE02 I DGPTERC S DGPTERC=506 D ERR G:DGPTEDFL EXIT G LSPEC
18 ;-- Active treating specialty edit check
19 I $E(DGPTTSC,1)=0!($E(DGPTTSC,1)=" ") S DGPTTSC=$E(DGPTTSC,2)
20 ; DGPTTSC := ptf code (alpha-numeric) value (file:42.4,field:7)
21 ; DGPTTSC1 := dinum value (file:42.4,field:.001)
22 S DGPTTSC1=+$O(^DIC(42.4,"C",DGPTTSC,0))
23 ;-- If not active treat spec, set 535 flag to print error msg during
24 ;-- PTF close-out error display at WRER^DGPTAEE
25 I '$$ACTIVE^DGACT(42.4,DGPTTSC1,DGPTTDTS) S DGPTERC=506,DGPTSER(DGPTTDTS_535)=1 D ERR G:DGPTEDFL EXIT
26LSPEC ;
27 N DGPTTLC1
28 I DGPTTLC'?2AN S DGPTERC=506 D ERR G:DGPTEDFL EXIT
29 S DGPTSP1=$E(DGPTTLC,1),DGPTSP2=$E(DGPTTLC,2),DGPTERC=0
30 D CHECK^DGPTAE02 I DGPTERC S DGPTERC=506 D ERR G:DGPTEDFL EXIT G LVPAS
31 ;-- Active treating specialty edit check
32 I $E(DGPTTLC,1)=0!($E(DGPTTLC,1)=" ") S DGPTTLC=$E(DGPTTLC,2)
33 ; DGPTTLC := ptf code (alpha-nemeric) value (file:42.4,field:7)
34 ; DGPTTLC1 := dinum value (file:42.4,field:.001)
35 S DGPTTLC1=+$O(^DIC(42.4,"C",DGPTTLC,0))
36 ;-- If not active treat spec, set 535 flag to print error msg during
37 ;-- PTF close-out error display at WRER^DGPTAEE
38 I '$$ACTIVE^DGACT(42.4,DGPTTLC1,DGPTTDTS) S DGPTERC=506,DGPTSER(DGPTTDTS_5351)=1 D ERR G:DGPTEDFL EXIT
39LVPAS ;
40 I DGPTTLD'?1.3N&(DGPTTLD'=" ") S DGPTERC=507 D ERR G:DGPTEDFL EXIT
41 I DGPTTPD'?1.3N&(DGPTTPD'=" ") S DGPTERC=508 D ERR G:DGPTEDFL EXIT
42 S DGPTERC=0 S X1=DGPTTDTS D 535^DGPTAE03 D:DGPTERC ERR G:DGPTEDFL EXIT
43ALLGD ;
44 W "."
45 ;
46EXIT ;
47 K DGPTTDT,DGPTTLR,DGPTTLC,DGPTTSR,DGPTTSC,DGPTTLD,DGPTTPD,DGPTSTR
48 K DGPTLO1,DGPTLO2,DGPTS1,DGPTS2,DGPTTDTS,DGPTTDDS,DGPTXX,X,X1,Y
49 Q
50ERR ;
51 D WRTERR^DGPTAE(DGPTERC,NODE,SEQ)
52 Q
Note: See TracBrowser for help on using the repository browser.