- 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 Mar 13, 2025@21:57:25 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
