| [613] | 1 | DGPT535 ;ALB/MTC - Process 535 transmission ; 16 NOV 92
|
|---|
| 2 | ;;5.3;Registration;**64,164,729**;Aug 13, 1993;Build 59
|
|---|
| 3 | ;
|
|---|
| 4 | EN ;
|
|---|
| 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")
|
|---|
| 8 | SET ;
|
|---|
| 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)
|
|---|
| 10 | DTE ;
|
|---|
| 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
|
|---|
| 13 | TSPEC ;
|
|---|
| 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
|
|---|
| 26 | LSPEC ;
|
|---|
| 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
|
|---|
| 39 | LVPAS ;
|
|---|
| 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
|
|---|
| 43 | ALLGD ;
|
|---|
| 44 | W "."
|
|---|
| 45 | ;
|
|---|
| 46 | EXIT ;
|
|---|
| 47 | K DGPTTDT,DGPTTLR,DGPTTLC,DGPTTSR,DGPTTSC,DGPTTLD,DGPTTPD,DGPTSTR
|
|---|
| 48 | K DGPTLO1,DGPTLO2,DGPTS1,DGPTS2,DGPTTDTS,DGPTTDDS,DGPTXX,X,X1,Y
|
|---|
| 49 | Q
|
|---|
| 50 | ERR ;
|
|---|
| 51 | D WRTERR^DGPTAE(DGPTERC,NODE,SEQ)
|
|---|
| 52 | Q
|
|---|
