| 1 | DGPTFVC ;ALB/MTC - PTF VALIDITY CHECK ; 01 MAY 91 @0800
|
|---|
| 2 | ;;5.3;Registration;**37,234**;Aug 13, 1993
|
|---|
| 3 | PTF S DIC="^DGPT(",DIC(0)="MAQE",DIC("S")="I $P(^(0),U,11)=1" D ^DIC K DIC Q:Y'>0 S DGERR=-1,(PTF,J)=+Y D LOG^DGPTFTR W:DGERR'>0 !," NO ERRORS"
|
|---|
| 4 | K DGLOGIC,DGDD,DGERR G PTF
|
|---|
| 5 | Q
|
|---|
| 6 | EN ;entry point from menu option DG PTF VALIDITY CHECK
|
|---|
| 7 | ;--setup vars for Austin Edits
|
|---|
| 8 | K ^TMP("AEDIT",$J),^TMP("AERROR",$J) S DGACNT=0
|
|---|
| 9 | ;
|
|---|
| 10 | S DIC="^DGPT(",DIC(0)="MAQE",DIC("S")="I $P(^(0),U,11)=1" D ^DIC K DIC I Y'>0 K DGACNT Q
|
|---|
| 11 | N DGSDFN S DGSDFN=$P(Y,U,2)
|
|---|
| 12 | S PTF=+Y,Y=$S($D(^DGPT(+Y,70)):+^(70),1:0) D FMT^DGPTUTL
|
|---|
| 13 | S:DT<2901001 DGPTFMT=1 ; needed so test sites can still validate 80col.
|
|---|
| 14 | S Y=1 D RTY^DGPTUTL
|
|---|
| 15 | S DGERR=0,DGCNT=1,J=PTF
|
|---|
| 16 | D SETTRAN G:DGOUT Q
|
|---|
| 17 | D LOG^DGPTFTR G Q:DGERR>0
|
|---|
| 18 | W !,"Performing Additional Edits..." D ^DGPTAE G Q:DGERR>0
|
|---|
| 19 | XMIT K XMY S XMZ=DGXMZ,XMDUZ=.5,XMY(DUZ)="",DGJ=J,^XMB(3.9,XMZ,2,0)="3.92A^"_DGCNT-1_"^"_DGCNT-1_"^"_DT
|
|---|
| 20 | D ENT1^XMD
|
|---|
| 21 | W !,"Message Sent"
|
|---|
| 22 | ;
|
|---|
| 23 | Q K DGXMZ,XMZ,XMDUN,XMY,DGOUT,DGLOGIC,DGERR,XMDUZ,DGRTY,DGRTY0,DGPTFMT,XMSUB,XMTEXT,Y,J,PTF,DGJ,DGCNT,DGACNT G EN
|
|---|
| 24 | SETTRAN ;-- setup mailman transmission
|
|---|
| 25 | S DGOUT=0
|
|---|
| 26 | S Y=$P(^DPT(+^DGPT(+J,0),0),U,1),XMSUB=Y_" PTF TRANSMISSION ",XMDUZ=DUZ,XMDUN=$P(^VA(200,DUZ,0),U)
|
|---|
| 27 | D GET^XMA2
|
|---|
| 28 | I $D(XMZ),(XMZ>0) S DGXMZ=XMZ K XMZ G SETQ
|
|---|
| 29 | W !,"*** ERROR *** Unable to create MailMan message... Try again later"
|
|---|
| 30 | S DGOUT=1
|
|---|
| 31 | SETQ ;
|
|---|
| 32 | Q
|
|---|
