DGPTFVC1 ;ALB/AS/ADL - Expanded PTF Close-Out Edits ; 12/14/04 10:34am
;;5.3;PIMS;**52,58,79,114,164,400,342,466,415,493,512,510,544,629,1015,1016**;JUN 30, 2012;Build 20
;;ADL;Updated for CSV Project;;Mar 26, 2003
;Called from Q+2^DGPTFTR. Variable must be passed in: PTF
;Variable returned: DGERR. DGERR <-- 1 if record fails to pass a check; DGERR <-- "" if record passes all checks
;
Q:'$D(PTF)
S DGERR="",DGV(701)=$S($D(^DGPT(PTF,70)):^(70),1:""),DGV(101)=^(0),DGSUFFIX=$P(DGV(101),"^",5),DGV("FEE")=$P(DGV(101),"^",4),DFN=$P(DGV(101),"^",1)
;
I $P(DGV(101),"^",2)>2820700 D AO
;
I DGRTY=1,DGV("FEE") D MT
;
; DG*512, sck/Remove 101-Means Test indicator = 'U' xmit block
;I 'DGV("FEE"),$P(DGV(101),"^",10)="U",'DGV(701)!(+DGV(701)>2890700) S DGERR=1 W !,"101 MEANS TEST",?23," value 'U' - not valid for discharges as of 7/1/1989",!?42,"per MAS VACO policy"
;
I $D(^DPT(DFN,57)),$P(^(57),"^",4)>0 S S0=$P(^(57),"^",4),DGDX=$S(S0=1!(S0=3):"344.1",1:"344.0"),DGSCI="" F DGX=0:0 S DGX=$O(^DGPT(PTF,"M",DGX)) Q:DGX'>0 S DGNODE=^(DGX,0),DGSCI="" D SCI
;
S DGDP="",DGDISPO=$P(DGV(701),"^",6),DGRECSUF=$P(DGV(701),"^",13)
I DGRTY=1 D
.S DGSTATYP=$S(DGDISPO=12!(DGDISPO=13):30,DGDISPO=10:42,DGDISPO=8:40,1:"")
.I DGSTATYP]"" D
..D NUMACT^DGPTSUF(DGSTATYP)
..I DGANUM>0 F I=1:1:DGANUM I DGSUFFIX=DGSUFNAM(I) D
...I DGDISPO'=8 I DGRECSUF=DGSUFNAM(DGANUM) S DGDP=5 D DP
...I DGDISPO=8 N DGANUM,DGSUFNAM D NUMACT^DGPTSUF(42) I DGRECSUF=DGSUFNAM(DGANUM) S DGDP=5 D DP
.K DGANUM,DGSTATYP,DGSUFNAM,I
;
I DGRTY=1 S %=$P(DGV(701),"^",3) I %=4!(%=6)!(%=7) S DGDP="" D OP I $P(DGV(701),"^",5)=1 S DGERR=1 W !,"701 VA AUSPICES",?23," value inconsistent for discharge"
;
;I 'DGV("FEE") S %=$P(^DPT(DFN,0),"^",6),%=$S($D(^DIC(10,+%,0)):$P(^(0),"^",2),1:"") I '%!(%>7) S DGERR=1 W !,"701 RACE",?23," value " W:%']"" "blank" I %]"" W %," (invalid code)"
;
;If PRRTP treating specialty, must have valid PRRTP suffix
;Fee records would not contain PRRTP specialties
I 'DGV("FEE"),"^25^26^27^28^29^38^39^"[(U_$P(DGV(701),U,2)_U) D
.I DGSUFFIX'="PA",(DGSUFFIX'="PB"),(DGSUFFIX'="PC"),(DGSUFFIX'="PD") D
..S DGERR=1
..W !,"101 SUFFIX",?23,"value must be set to a valid PRRTP suffix."
;
D RACETHNC
K DGDISPO,DGRECSUF,DGV,DGDP,DGDX,DGSCI,DGSUFFIX,DGNODE,DGX,%,S0,I,X
I DGERR H 4
Q
;
SCI F X=5:1:15 I X#10 S DGPTTMP=$$ICDDX^ICDCODE(+$P(DGNODE,"^",X),$$GETDATE^ICDGTDRG(PTF)) I +DGPTTMP>0&($P(DGPTTMP,U,10)) S:$E($P(DGPTTMP,"^",2),1,5)=DGDX DGSCI=1 Q:DGSCI
I 'DGSCI S DGERR=1,%=$P(DGNODE,"^",10),X=$TR($$FMTE^XLFDT(%,"5DF")," ","0") W !,"501 ",X," SCI of ",S0,?23," requires an ICD Diagnosis code beginning with",!?12," or equal to ",DGDX
Q
;
MT S DGVMT=$P(DGV(101),"^",10),DGX=999 G DGX:DGVMT']"" I +$P(DGV(101),"^",2)<2860700!(DGSUFFIX="BU") S DGX="X" G DGX
;S DGZEC=$S($D(^DPT(DFN,.36)):$P(^(.36),U,1),1:""),DGZEC=$S($D(^DIC(8,+DGZEC,0)):^(0),1:"") I $P(DGZEC,U,5)="N" S DGX="N" G DGX
S DGZEC=$P($G(^DGPT(PTF,101)),U,8),DGZEC=$S($D(^DIC(8,+DGZEC,0)):^(0),1:"") I $P(DGZEC,U,5)="N" S DGX="N" G DGX
S DGT=$P(DGV(701),".") G AS:'$O(^DGMT(408.31,"AD",1,DFN,0)) S DGZ1=$$LST^DGMTU(DFN,DGT) K:DGZ1']"" DGZ1
I DGVMT="X" K DGX,DGVMT Q
S DGX=$S('$D(DGZ1):"U",1:$P(DGZ1,U,4))
; Determine if the Pending Adjudication is for MT(C) or GMT(G)
I DGX="P" D G DGX
. I '+$P($G(DGZ1),U) S DGX="U" Q
. S DGX=$$PA^DGMTUTL($P(DGZ1,U)),DGX=$S('$D(DGX):"U",DGX="MT":"C",DGX="GMT":"G",1:"U")
; sc < 50%, 0% non-comp, sc movements - DG*5.3*544
I DGX="A",$P(DGZEC,U,4)=3,$$SC^DGMTR(DFN),$$ANYSC^DGPTSCAN(PTF) S DGX="AS" G DGX
;-- sc, >0% - DG*5.3*544
I DGX="A","^1^3^"[("^"_$P(DGZEC,U,4)_"^"),$P($G(^DPT(DFN,.3)),U,2)>0 S DGX="AS" G DGX
S DGX=$S(DGX="A":"AN","BCGN"[DGX:DGX,1:"U") G AS:DGX="U" G DGX:DGX'="N"
AS S DGZ=$S($D(^DPT(DFN,.321)):^(.321),1:0) I $P(DGZ,U,2)="Y"!($P(DGZ,U,3)="Y") S DGX="AS" G DGX
S DGZ=$S($D(^DPT(DFN,.322)):^(.322),1:0) I $P(DGZ,U,13)="Y" S DGX="AS" G DGX
N DGNTARR S DGZ=$S($$GETCUR^DGNTAPI(DFN,"DGNTARR")>0:DGNTARR("NTR"),1:"") I $P(DGZ,U)="Y" S DGX="AS" G DGX
S DGZ=$$GETSTAT^DGMSTAPI(DFN) I $P(DGZ,U,2)="Y" S DGX="AS" G DGX
I $P(DGZEC,U,5)="Y",$P(DGZEC,U,4)<4,"^2^15^"'[(U_$P(DGZEC,U,9)_U) S DGX="AS" G DGX
S DGX="AN"
DGX ;DG*5.3*817/Remove 101-Means Test indicator = 'U' xmit block for FEE BASIS PTF
I DGVMT'=DGX,DGVMT'="U" S DGERR=1 W !,"101 ","MEANS TEST",?23," value ",DGVMT,$S(DGVMT']"":"blank",DGVMT="X":" only for admissions prior to 7/1/86 or domicilliary use",1:" inconsistent with eligibility data")
K DGZEC,DGZ,DGZ1,DGT,DGX,DGVMT Q
;
DP I $P(DGV(701),"^",3)'=5 S DGERR=1 W !,"701 ",$E("TYPE OF DISPOSITION",1,18),?23," value inconsistent for discharge"
OP I $P(DGV(701),"^",4)=1 S DGERR=1 W !,"701 ",$E("OUTPATIENT TREATMENT",1,18),?23," value inconsistent for discharge" Q:DGDP=""
I $P(DGV(701),"^",5)=2 S DGERR=1 W !,"701 VA AUSPICES",?23," value inconsistent for discharge"
Q
;
AO I DGPTFMT<2 D Q
.S %=$S($D(^DGPT(PTF,101)):$P(^(101),"^",4),1:"")
.S %=$S($D(^DIC(45.82,+%,0)):$P(^(0),"^",1),1:"")
.S I=$S($D(^DPT(DFN,.321)):^(.321),1:"")
.S:$P(I,"^",2)="Y"&(%'=6) DGERR=1,DGV("E")=1
.W:$D(DGV("E")) !,"101 AGENT ORANGE",?23," value ",$S(DGV("E"):"can only be used with COB of '6'",1:"is inconsistent with Vietnam Service and/or COB")
;
N AO,AOL,TMP
S TMP=$G(^DPT(DFN,.321))
S AO=$S($P(TMP,"^",2)="Y":1,1:0)
S AOL=$P(TMP,"^",13)
Q:('AO)
Q:(AOL'="")
S DGERR=1,DGV("E")=1
W !,"101 AGENT ORANGE LOCATION",?23,"value required if exposure to Agent Orange claimed"
Q
RACETHNC ;Race and ethnicity check
;Ensure that a value for ethnicity and at least one race is on file.
;Ensure all active race/ethnicity values have a valid PTF value and an
;associated collection method. Ensure all collection methods have a
;valid PTF value. Ignore race/ethicity entries that are inactive or
;invalid pointers. Note: PTF sends first active ethnicity and first
;six active races.
N REF,IEN,TYPE,TEXT,PTRVAL,PTRMTHD,NUM,MAX
N VALIDVAL,VALIDMTH,VALUE,VADM
D DEM^VADPT
F REF=11,12 D
.I REF=12 D
..S MAX=6
..S TYPE=1
..S VALIDVAL=",3,8,9,A,B,C,D,"
..S VALIDMTH=",S,P,O,U,"
..S TEXT="RACE"
.I REF=11 D
..S MAX=1
..S TYPE=2
..S TEXT="ETHNICITY"
..S VALIDVAL=",H,N,D,U,"
..S VALIDMTH=",S,P,O,U,"
.S NUM=1
.S IEN=0
.F S IEN=+$O(VADM(REF,IEN)) Q:'IEN D Q:NUM>MAX
..S PTRVAL=+VADM(REF,IEN)
..S PTRMTHD=+$G(VADM(REF,IEN,1))
..Q:'PTRVAL
..Q:$$INACTIVE^DGUTL4(PTRVAL,TYPE)
..S NUM=NUM+1
..S VALUE=$$PTR2CODE^DGUTL4(PTRVAL,TYPE,4)
..I (VALUE="")!(VALIDVAL'[VALUE) D Q
...W !,"701 ",TEXT,?23,"missing/invalid xmit value"
...S DGERR=1
..I ('PTRMTHD) D Q
...W !,"701 ",TEXT,?23,"method of collection missing/invalid"
...S DGERR=1
..S VALUE=$$PTR2CODE^DGUTL4(PTRMTHD,3,4)
..I (VALUE="")!(VALIDMTH'[VALUE) D Q
...W !,"701 ",TEXT,?23,"missing/invalid xmit value for method of collection"
...S DGERR=1
Q
DGPTFVC1 ;ALB/AS/ADL - Expanded PTF Close-Out Edits ; 12/14/04 10:34am
+1 ;;5.3;PIMS;**52,58,79,114,164,400,342,466,415,493,512,510,544,629,1015,1016**;JUN 30, 2012;Build 20
+2 ;;ADL;Updated for CSV Project;;Mar 26, 2003
+3 ;Called from Q+2^DGPTFTR. Variable must be passed in: PTF
+4 ;Variable returned: DGERR. DGERR <-- 1 if record fails to pass a check; DGERR <-- "" if record passes all checks
+5 ;
+6 IF '$DATA(PTF)
QUIT
+7 SET DGERR=""
SET DGV(701)=$SELECT($DATA(^DGPT(PTF,70)):^(70),1:"")
SET DGV(101)=^(0)
SET DGSUFFIX=$PIECE(DGV(101),"^",5)
SET DGV("FEE")=$PIECE(DGV(101),"^",4)
SET DFN=$PIECE(DGV(101),"^",1)
+8 ;
+9 IF $PIECE(DGV(101),"^",2)>2820700
DO AO
+10 ;
+11 IF DGRTY=1
IF DGV("FEE")
DO MT
+12 ;
+13 ; DG*512, sck/Remove 101-Means Test indicator = 'U' xmit block
+14 ;I 'DGV("FEE"),$P(DGV(101),"^",10)="U",'DGV(701)!(+DGV(701)>2890700) S DGERR=1 W !,"101 MEANS TEST",?23," value 'U' - not valid for discharges as of 7/1/1989",!?42,"per MAS VACO policy"
+15 ;
+16 IF $DATA(^DPT(DFN,57))
IF $PIECE(^(57),"^",4)>0
SET S0=$PIECE(^(57),"^",4)
SET DGDX=$SELECT(S0=1!(S0=3):"344.1",1:"344.0")
SET DGSCI=""
FOR DGX=0:0
SET DGX=$ORDER(^DGPT(PTF,"M",DGX))
IF DGX'>0
QUIT
SET DGNODE=^(DGX,0)
SET DGSCI=""
DO SCI
+17 ;
+18 SET DGDP=""
SET DGDISPO=$PIECE(DGV(701),"^",6)
SET DGRECSUF=$PIECE(DGV(701),"^",13)
+19 IF DGRTY=1
Begin DoDot:1
+20 SET DGSTATYP=$SELECT(DGDISPO=12!(DGDISPO=13):30,DGDISPO=10:42,DGDISPO=8:40,1:"")
+21 IF DGSTATYP]""
Begin DoDot:2
+22 DO NUMACT^DGPTSUF(DGSTATYP)
+23 IF DGANUM>0
FOR I=1:1:DGANUM
IF DGSUFFIX=DGSUFNAM(I)
Begin DoDot:3
+24 IF DGDISPO'=8
IF DGRECSUF=DGSUFNAM(DGANUM)
SET DGDP=5
DO DP
+25 IF DGDISPO=8
NEW DGANUM,DGSUFNAM
DO NUMACT^DGPTSUF(42)
IF DGRECSUF=DGSUFNAM(DGANUM)
SET DGDP=5
DO DP
End DoDot:3
End DoDot:2
+26 KILL DGANUM,DGSTATYP,DGSUFNAM,I
End DoDot:1
+27 ;
+28 IF DGRTY=1
SET %=$PIECE(DGV(701),"^",3)
IF %=4!(%=6)!(%=7)
SET DGDP=""
DO OP
IF $PIECE(DGV(701),"^",5)=1
SET DGERR=1
WRITE !,"701 VA AUSPICES",?23," value inconsistent for discharge"
+29 ;
+30 ;I 'DGV("FEE") S %=$P(^DPT(DFN,0),"^",6),%=$S($D(^DIC(10,+%,0)):$P(^(0),"^",2),1:"") I '%!(%>7) S DGERR=1 W !,"701 RACE",?23," value " W:%']"" "blank" I %]"" W %," (invalid code)"
+31 ;
+32 ;If PRRTP treating specialty, must have valid PRRTP suffix
+33 ;Fee records would not contain PRRTP specialties
+34 IF 'DGV("FEE")
IF "^25^26^27^28^29^38^39^"[(U_$PIECE(DGV(701),U,2)_U)
Begin DoDot:1
+35 IF DGSUFFIX'="PA"
IF (DGSUFFIX'="PB")
IF (DGSUFFIX'="PC")
IF (DGSUFFIX'="PD")
Begin DoDot:2
+36 SET DGERR=1
+37 WRITE !,"101 SUFFIX",?23,"value must be set to a valid PRRTP suffix."
End DoDot:2
End DoDot:1
+38 ;
+39 DO RACETHNC
+40 KILL DGDISPO,DGRECSUF,DGV,DGDP,DGDX,DGSCI,DGSUFFIX,DGNODE,DGX,%,S0,I,X
+41 IF DGERR
HANG 4
+42 QUIT
+43 ;
SCI FOR X=5:1:15
IF X#10
SET DGPTTMP=$$ICDDX^ICDCODE(+$PIECE(DGNODE,"^",X),$$GETDATE^ICDGTDRG(PTF))
IF +DGPTTMP>0&($PIECE(DGPTTMP,U,10))
IF $EXTRACT($PIECE(DGPTTMP,"^",2),1,5)=DGDX
SET DGSCI=1
IF DGSCI
QUIT
+1 IF 'DGSCI
SET DGERR=1
SET %=$PIECE(DGNODE,"^",10)
SET X=$TRANSLATE($$FMTE^XLFDT(%,"5DF")," ","0")
WRITE !,"501 ",X," SCI of ",S0,?23," requires an ICD Diagnosis code beginning with",!?12," or equal to ",DGDX
+2 QUIT
+3 ;
MT SET DGVMT=$PIECE(DGV(101),"^",10)
SET DGX=999
IF DGVMT']""
GOTO DGX
IF +$PIECE(DGV(101),"^",2)<2860700!(DGSUFFIX="BU")
SET DGX="X"
GOTO DGX
+1 ;S DGZEC=$S($D(^DPT(DFN,.36)):$P(^(.36),U,1),1:""),DGZEC=$S($D(^DIC(8,+DGZEC,0)):^(0),1:"") I $P(DGZEC,U,5)="N" S DGX="N" G DGX
+2 SET DGZEC=$PIECE($GET(^DGPT(PTF,101)),U,8)
SET DGZEC=$SELECT($DATA(^DIC(8,+DGZEC,0)):^(0),1:"")
IF $PIECE(DGZEC,U,5)="N"
SET DGX="N"
GOTO DGX
+3 SET DGT=$PIECE(DGV(701),".")
IF '$ORDER(^DGMT(408.31,"AD",1,DFN,0))
GOTO AS
SET DGZ1=$$LST^DGMTU(DFN,DGT)
IF DGZ1']""
KILL DGZ1
+4 IF DGVMT="X"
KILL DGX,DGVMT
QUIT
+5 SET DGX=$SELECT('$DATA(DGZ1):"U",1:$PIECE(DGZ1,U,4))
+6 ; Determine if the Pending Adjudication is for MT(C) or GMT(G)
+7 IF DGX="P"
Begin DoDot:1
+8 IF '+$PIECE($GET(DGZ1),U)
SET DGX="U"
QUIT
+9 SET DGX=$$PA^DGMTUTL($PIECE(DGZ1,U))
SET DGX=$SELECT('$DATA(DGX):"U",DGX="MT":"C",DGX="GMT":"G",1:"U")
End DoDot:1
GOTO DGX
+10 ; sc < 50%, 0% non-comp, sc movements - DG*5.3*544
+11 IF DGX="A"
IF $PIECE(DGZEC,U,4)=3
IF $$SC^DGMTR(DFN)
IF $$ANYSC^DGPTSCAN(PTF)
SET DGX="AS"
GOTO DGX
+12 ;-- sc, >0% - DG*5.3*544
+13 IF DGX="A"
IF "^1^3^"[("^"_$PIECE(DGZEC,U,4)_"^")
IF $PIECE($GET(^DPT(DFN,.3)),U,2)>0
SET DGX="AS"
GOTO DGX
+14 SET DGX=$SELECT(DGX="A":"AN","BCGN"[DGX:DGX,1:"U")
IF DGX="U"
GOTO AS
IF DGX'="N"
GOTO DGX
AS SET DGZ=$SELECT($DATA(^DPT(DFN,.321)):^(.321),1:0)
IF $PIECE(DGZ,U,2)="Y"!($PIECE(DGZ,U,3)="Y")
SET DGX="AS"
GOTO DGX
+1 SET DGZ=$SELECT($DATA(^DPT(DFN,.322)):^(.322),1:0)
IF $PIECE(DGZ,U,13)="Y"
SET DGX="AS"
GOTO DGX
+2 NEW DGNTARR
SET DGZ=$SELECT($$GETCUR^DGNTAPI(DFN,"DGNTARR")>0:DGNTARR("NTR"),1:"")
IF $PIECE(DGZ,U)="Y"
SET DGX="AS"
GOTO DGX
+3 SET DGZ=$$GETSTAT^DGMSTAPI(DFN)
IF $PIECE(DGZ,U,2)="Y"
SET DGX="AS"
GOTO DGX
+4 IF $PIECE(DGZEC,U,5)="Y"
IF $PIECE(DGZEC,U,4)<4
IF "^2^15^"'[(U_$PIECE(DGZEC,U,9)_U)
SET DGX="AS"
GOTO DGX
+5 SET DGX="AN"
DGX ;DG*5.3*817/Remove 101-Means Test indicator = 'U' xmit block for FEE BASIS PTF
+1 IF DGVMT'=DGX
IF DGVMT'="U"
SET DGERR=1
WRITE !,"101 ","MEANS TEST",?23," value ",DGVMT,$SELECT(DGVMT']"":"blank",DGVMT="X":" only for admissions prior to 7/1/86 or domicilliary use",1:" inconsistent with eligibility data")
+2 KILL DGZEC,DGZ,DGZ1,DGT,DGX,DGVMT
QUIT
+3 ;
DP IF $PIECE(DGV(701),"^",3)'=5
SET DGERR=1
WRITE !,"701 ",$EXTRACT("TYPE OF DISPOSITION",1,18),?23," value inconsistent for discharge"
OP IF $PIECE(DGV(701),"^",4)=1
SET DGERR=1
WRITE !,"701 ",$EXTRACT("OUTPATIENT TREATMENT",1,18),?23," value inconsistent for discharge"
IF DGDP=""
QUIT
+1 IF $PIECE(DGV(701),"^",5)=2
SET DGERR=1
WRITE !,"701 VA AUSPICES",?23," value inconsistent for discharge"
+2 QUIT
+3 ;
AO IF DGPTFMT<2
Begin DoDot:1
+1 SET %=$SELECT($DATA(^DGPT(PTF,101)):$PIECE(^(101),"^",4),1:"")
+2 SET %=$SELECT($DATA(^DIC(45.82,+%,0)):$PIECE(^(0),"^",1),1:"")
+3 SET I=$SELECT($DATA(^DPT(DFN,.321)):^(.321),1:"")
+4 IF $PIECE(I,"^",2)="Y"&(%'=6)
SET DGERR=1
SET DGV("E")=1
+5 IF $DATA(DGV("E"))
WRITE !,"101 AGENT ORANGE",?23," value ",$SELECT(DGV("E"):"can only be used with COB of '6'",1:"is inconsistent with Vietnam Service and/or COB")
End DoDot:1
QUIT
+6 ;
+7 NEW AO,AOL,TMP
+8 SET TMP=$GET(^DPT(DFN,.321))
+9 SET AO=$SELECT($PIECE(TMP,"^",2)="Y":1,1:0)
+10 SET AOL=$PIECE(TMP,"^",13)
+11 IF ('AO)
QUIT
+12 IF (AOL'="")
QUIT
+13 SET DGERR=1
SET DGV("E")=1
+14 WRITE !,"101 AGENT ORANGE LOCATION",?23,"value required if exposure to Agent Orange claimed"
+15 QUIT
RACETHNC ;Race and ethnicity check
+1 ;Ensure that a value for ethnicity and at least one race is on file.
+2 ;Ensure all active race/ethnicity values have a valid PTF value and an
+3 ;associated collection method. Ensure all collection methods have a
+4 ;valid PTF value. Ignore race/ethicity entries that are inactive or
+5 ;invalid pointers. Note: PTF sends first active ethnicity and first
+6 ;six active races.
+7 NEW REF,IEN,TYPE,TEXT,PTRVAL,PTRMTHD,NUM,MAX
+8 NEW VALIDVAL,VALIDMTH,VALUE,VADM
+9 DO DEM^VADPT
+10 FOR REF=11,12
Begin DoDot:1
+11 IF REF=12
Begin DoDot:2
+12 SET MAX=6
+13 SET TYPE=1
+14 SET VALIDVAL=",3,8,9,A,B,C,D,"
+15 SET VALIDMTH=",S,P,O,U,"
+16 SET TEXT="RACE"
End DoDot:2
+17 IF REF=11
Begin DoDot:2
+18 SET MAX=1
+19 SET TYPE=2
+20 SET TEXT="ETHNICITY"
+21 SET VALIDVAL=",H,N,D,U,"
+22 SET VALIDMTH=",S,P,O,U,"
End DoDot:2
+23 SET NUM=1
+24 SET IEN=0
+25 FOR
SET IEN=+$ORDER(VADM(REF,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+26 SET PTRVAL=+VADM(REF,IEN)
+27 SET PTRMTHD=+$GET(VADM(REF,IEN,1))
+28 IF 'PTRVAL
QUIT
+29 IF $$INACTIVE^DGUTL4(PTRVAL,TYPE)
QUIT
+30 SET NUM=NUM+1
+31 SET VALUE=$$PTR2CODE^DGUTL4(PTRVAL,TYPE,4)
+32 IF (VALUE="")!(VALIDVAL'[VALUE)
Begin DoDot:3
+33 WRITE !,"701 ",TEXT,?23,"missing/invalid xmit value"
+34 SET DGERR=1
End DoDot:3
QUIT
+35 IF ('PTRMTHD)
Begin DoDot:3
+36 WRITE !,"701 ",TEXT,?23,"method of collection missing/invalid"
+37 SET DGERR=1
End DoDot:3
QUIT
+38 SET VALUE=$$PTR2CODE^DGUTL4(PTRMTHD,3,4)
+39 IF (VALUE="")!(VALIDMTH'[VALUE)
Begin DoDot:3
+40 WRITE !,"701 ",TEXT,?23,"missing/invalid xmit value for method of collection"
+41 SET DGERR=1
End DoDot:3
QUIT
End DoDot:2
IF NUM>MAX
QUIT
End DoDot:1
+42 QUIT
