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

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

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1DGPTFVC ;ALB/MTC - PTF VALIDITY CHECK ; 01 MAY 91 @0800
2 ;;5.3;Registration;**37,234**;Aug 13, 1993
3PTF 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
6EN ;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
19XMIT 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 ;
23Q K DGXMZ,XMZ,XMDUN,XMY,DGOUT,DGLOGIC,DGERR,XMDUZ,DGRTY,DGRTY0,DGPTFMT,XMSUB,XMTEXT,Y,J,PTF,DGJ,DGCNT,DGACNT G EN
24SETTRAN ;-- 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
31SETQ ;
32 Q
Note: See TracBrowser for help on using the repository browser.