DGPTFVC ;ALB/MTC - PTF VALIDITY CHECK ;01 MAY 91 @0800
;;5.3;Registration;**37,234,850**;Aug 13, 1993;Build 171
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"
K DGLOGIC,DGDD,DGERR G PTF
Q
EN ;entry point from menu option DG PTF VALIDITY CHECK
;--setup vars for Austin Edits
K ^TMP("AEDIT",$J),^TMP("AERROR",$J) S DGACNT=0
;
S DIC="^DGPT(",DIC(0)="MAQE",DIC("S")="I $P(^(0),U,11)=1" D ^DIC K DIC I Y'>0 K DGACNT Q
N DGSDFN S DGSDFN=$P(Y,U,2)
S PTF=+Y,Y=$S($D(^DGPT(+Y,70)):+^(70),1:0) D FMT^DGPTUTL
S:DT<2901001 DGPTFMT=1 ; needed so test sites can still validate 80col.
S Y=1 D RTY^DGPTUTL
S DGERR=0,DGCNT=1,J=PTF
D SETTRAN G:DGOUT Q
D LOG^DGPTFTR G Q:DGERR>0
D VERCHK^DGPTRI3(PTF) G Q:DGERR>0 ; for ICD-10 validate that record is all of correct type
W !,"Performing Additional Edits..." D ^DGPTAE G Q:DGERR>0
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
D ENT1^XMD
W !,"Message Sent"
;
Q K DGXMZ,XMZ,XMDUN,XMY,DGOUT,DGLOGIC,DGERR,XMDUZ,DGRTY,DGRTY0,DGPTFMT,XMSUB,XMTEXT,Y,J,PTF,DGJ,DGCNT,DGACNT G EN
SETTRAN ;-- setup mailman transmission
S DGOUT=0
S Y=$P(^DPT(+^DGPT(+J,0),0),U,1),XMSUB=Y_" PTF TRANSMISSION ",XMDUZ=DUZ,XMDUN=$P(^VA(200,DUZ,0),U)
D GET^XMA2
I $D(XMZ),(XMZ>0) S DGXMZ=XMZ K XMZ G SETQ
W !,"*** ERROR *** Unable to create MailMan message... Try again later"
S DGOUT=1
SETQ ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTFVC 1511 printed Nov 22, 2024@18:02:41 Page 2
DGPTFVC ;ALB/MTC - PTF VALIDITY CHECK ;01 MAY 91 @0800
+1 ;;5.3;Registration;**37,234,850**;Aug 13, 1993;Build 171
PTF SET DIC="^DGPT("
SET DIC(0)="MAQE"
SET DIC("S")="I $P(^(0),U,11)=1"
DO ^DIC
KILL DIC
if Y'>0
QUIT
SET DGERR=-1
SET (PTF,J)=+Y
DO LOG^DGPTFTR
if DGERR'>0
WRITE !," NO ERRORS"
+1 KILL DGLOGIC,DGDD,DGERR
GOTO PTF
+2 QUIT
EN ;entry point from menu option DG PTF VALIDITY CHECK
+1 ;--setup vars for Austin Edits
+2 KILL ^TMP("AEDIT",$JOB),^TMP("AERROR",$JOB)
SET DGACNT=0
+3 ;
+4 SET DIC="^DGPT("
SET DIC(0)="MAQE"
SET DIC("S")="I $P(^(0),U,11)=1"
DO ^DIC
KILL DIC
IF Y'>0
KILL DGACNT
QUIT
+5 NEW DGSDFN
SET DGSDFN=$PIECE(Y,U,2)
+6 SET PTF=+Y
SET Y=$SELECT($DATA(^DGPT(+Y,70)):+^(70),1:0)
DO FMT^DGPTUTL
+7 ; needed so test sites can still validate 80col.
if DT<2901001
SET DGPTFMT=1
+8 SET Y=1
DO RTY^DGPTUTL
+9 SET DGERR=0
SET DGCNT=1
SET J=PTF
+10 DO SETTRAN
if DGOUT
GOTO Q
+11 DO LOG^DGPTFTR
if DGERR>0
GOTO Q
+12 ; for ICD-10 validate that record is all of correct type
DO VERCHK^DGPTRI3(PTF)
if DGERR>0
GOTO Q
+13 WRITE !,"Performing Additional Edits..."
DO ^DGPTAE
if DGERR>0
GOTO Q
XMIT KILL XMY
SET XMZ=DGXMZ
SET XMDUZ=.5
SET XMY(DUZ)=""
SET DGJ=J
SET ^XMB(3.9,XMZ,2,0)="3.92A^"_DGCNT-1_"^"_DGCNT-1_"^"_DT
+1 DO ENT1^XMD
+2 WRITE !,"Message Sent"
+3 ;
Q KILL DGXMZ,XMZ,XMDUN,XMY,DGOUT,DGLOGIC,DGERR,XMDUZ,DGRTY,DGRTY0,DGPTFMT,XMSUB,XMTEXT,Y,J,PTF,DGJ,DGCNT,DGACNT
GOTO EN
SETTRAN ;-- setup mailman transmission
+1 SET DGOUT=0
+2 SET Y=$PIECE(^DPT(+^DGPT(+J,0),0),U,1)
SET XMSUB=Y_" PTF TRANSMISSION "
SET XMDUZ=DUZ
SET XMDUN=$PIECE(^VA(200,DUZ,0),U)
+3 DO GET^XMA2
+4 IF $DATA(XMZ)
IF (XMZ>0)
SET DGXMZ=XMZ
KILL XMZ
GOTO SETQ
+5 WRITE !,"*** ERROR *** Unable to create MailMan message... Try again later"
+6 SET DGOUT=1
SETQ ;
+1 QUIT
