AGELUP4 ;IHS/SET/GTH - UPDATE ELIGIBILITY FROM FILE
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
D(AG) ;EP - process Medicaid
;See update matrix, in FILE subroutine.
KILL AG1,AG2,AGSAME
;Check for -exact- match, -or- all Elig dates.
I $D(^AUPNMCD("AB",AG("DFN"),AGMCDST)) D Q:$G(AGSAME)
. S AG("MNBR")=""
. F S AG("MNBR")=$O(^AUPNMCD("AB",AG("DFN"),AGMCDST,AG("MNBR"))) Q:'$L(AG("MNBR")) D Q:$G(AGSAME)
.. S AG("IEN")=0
.. F S AG("IEN")=$O(^AUPNMCD("AB",AG("DFN"),AGMCDST,AG("MNBR"),AG("IEN"))) Q:'AG("IEN") D MCDY I AGSAME S AGACT="S" Q
..Q
.Q
;Find most recent entry that matches demographic data (no dates).
;If found AG("IEN") will be it.
I $D(^AUPNMCD("AB",AG("DFN"),AGMCDST)) D
. S AG("MNBR")=""
. F S AG("MNBR")=$O(^AUPNMCD("AB",AG("DFN"),AGMCDST,AG("MNBR")),-1) Q:'$L(AG("MNBR")) D Q:$G(AGSAME)
.. S AG("IEN")=""
.. F S AG("IEN")=$O(^AUPNMCD("AB",AG("DFN"),AGMCDST,AG("MNBR"),AG("IEN")),-1) Q:'AG("IEN") D Q:$G(AGSAME)
... ;MediCaid name.
... Q:'(AG("FNM")=$P($G(^AUPNMCD(AG("IEN"),21)),U,1))
... ;MediCaid DOB.
... Q:'(AG("FDOB")=$P($G(^AUPNMCD(AG("IEN"),21)),U,2))
... ;MediCaid Number.
... I '(AG("FNBR")=$P(^AUPNMCD(AG("IEN"),0),U,3)),'((+AG("FNBR"))=(+$P(^AUPNMCD(AG("IEN"),0),U,3))) Q
... S AGSAME=1
...Q
..Q
.Q
;If demographic data does not match, but Pt has MCD entry,
;get highest IEN.
I '$G(AG("IEN")),$D(^AUPNMCD("AB",AG("DFN"),AGMCDST)) NEW I D I I S AG("IEN")=I
. NEW N,T
. S N="",I=0
. F S N=$O(^AUPNMCD("AB",AG("DFN"),AGMCDST,N)) Q:'$L(N) S T=$O(^(N,0)) I T>I S I=T
.Q
I $G(AG("IEN")) D MCDY ;Make sure Dif flags are set.
I AGAUTO'="A" D Q
. D HEAD^AGELUPUT("MEDICAID")
. I '$D(^AUPNMCD("AB",AG("DFN"),AGMCDST)) D MCDN
. D MDISP^AGELUP2(5),PEND^AGELUPUT
.Q
U IO(0)
W "."
W:'(AGRCNT#100) $J(AGRCNT,8)
Q
MCDY ;if medicaid coverage
S AGSAME=0
;MediCaid name.
S (AGMNM,AG1(1))=$P($G(^AUPNMCD(AG("IEN"),21)),U)
;MediCaid DOB.
S AGMDOB=$P($G(^AUPNMCD(AG("IEN"),21)),U,2)
S AG1(2)=AGMDOB
;MediCaid Number.
S (AGMNBR,AG1(3))=$P(^AUPNMCD(AG("IEN"),0),U,3)
S AG1(4)=""
;AG1("DT",EligDt,CovType)=EligDt^ELigEndDt^CovType
S DA=0
F S DA=$O(^AUPNMCD(AG("IEN"),11,DA)) Q:'DA S %=^(DA,0) S:$P(%,U,3)="" $P(%,U,3)=" " S AG1("DT",$P(%,U,1),$P(%,U,3))=%
KILL AGFL
D DFL
S:'$D(AGFL) AGSAME=1
Q
MCDN ;EP - No MCD coverage in rpms.
S AG1(1)="NO ELIGIBILITY ON FILE"
F I=2:1:4 S AG1(I)=""
D DFL
Q
DFL ;EP - Set descrepency flags.
KILL AGFL
;M/M Name.
S AG2(1)=$G(AG("FNM"))
S:AG2(1)'=$G(AGMNM) AGFL(1)=1
;DOB.
S AG2(2)=$G(AG("FDOB"))
S:AG2(2)'=$G(AGMDOB) AGFL(2)=1
;Number. Check for leading 0's.
S AG2(3)=$G(AG("FNBR"))
I '(AG2(3)=$G(AGMNBR)),'((+AG2(3))=(+$G(AGMNBR))) S AGFL(3)=1
S AG2(4)="" ;Prevent UNDEF.
;Compare file eligibilities with existing eligibilities.
;AG1("DT",EligDt,CovType)=EligDt^ELigEndDt^CovType
;Make the comparison based on the update matrix in FILE(), below.
;AG("DT",,) contains the State data.
NEW I,J
S I=0
F S I=$O(AG("DT",I)) Q:'I D
. S J=0
. F S J=$O(AG("DT",I,J)) Q:J="" D
.. I '$G(AG1("DT",I,J)) S AGFL(5)=1 Q
.. I AG1("DT",I,J)=AG("DT",I,J) Q
.. I $P(AG("DT",I,J),U,2)="" Q ;State EndDate is blank.
.. I $P(AG1("DT",I,J),U,2)>$P(AG("DT",I,J),U,2) Q
.. S AGFL(5)=1
..Q
.Q
;AG1("DT",,) contains RPMS data.
S I=0
F S I=$O(AG1("DT",I)) Q:'I D
. S J=0
. F S J=$O(AG1("DT",I,J)) Q:J="" D
.. Q:'$D(AG("DT",I,U)) ;Exists in RPMS but not in STATE.
.. I $P(AG("DT",I,J),U,2)="" Q ;State EndDate is blank.
.. I $P(AG1("DT",I,J),U,2)>$P(AG("DT",I,J),U,2) Q
.. S AGFL(5)=1
..Q
.Q
Q
FILE(AG) ;EP - File Medicaid
NEW AGADD,AGUPDATE
I '$G(AG("IEN")) D Q:+Y<0 S AGADD=1 I 1
. NEW DIC,DLAYGO,DD,DO
. I '("MF"[AG("FSEX")) S AG("FSEX")=""
. S DIC="^AUPNMCD(",DIC(0)="F",DLAYGO=9000004,X=AG("DFN")
. S DIC("DR")=".02////"_AGINSPT_";.03///"_AG("FNBR")_";.04////"_AGMCDST_$S($L(AG("FSEX")):";.07///"_AG("FSEX"),1:"")_";.08////"_DT_";2101///"_AG("FNM")_";2102///"_AG("FDOB")
. D FILE^DICN
. I +Y>0 S AG("IEN")=+Y D PTACT^AGELUP2(1,AG("DFN"))
.Q
E D S AGADD=0
. NEW DA,DIE,DR
. S DIE="^AUPNMCD(",DA=AG("IEN"),DR=""
. I $P(^AUPNMCD(DA,0),U,2)'=AGINSPT S DR=".02////"_AGINSPT
. I AG("FNBR")'="",AG("FNBR")'=$P(^AUPNMCD(DA,0),U,3) S DR=DR_$S($L(DR):";",1:"")_".03///"_AG("FNBR")
. I AG("FSEX")'="",AG("FSEX")'=$P(^AUPNMCD(DA,0),U,7) S DR=DR_$S($L(DR):";",1:"")_".07///"_AG("FSEX")
. I AG("FNM")'="",AG("FNM")'=$P($G(^AUPNMCD(DA,21)),U) S DR=DR_$S($L(DR):";",1:"")_"2101///"_AG("FNM")
. I AG("FDOB")'="",AG("FDOB")'=$P($G(^AUPNMCD(DA,21)),U,2) S DR=DR_$S($L(DR):";",1:"")_"2102////"_AG("FDOB")
. I $L(DR) NEW DITC S DITC="",DR=DR_";.08////"_DT D ^DIE,PTACT^AGELUP2(2,AG("DFN")):'$D(Y) KILL DITC
.Q
;Here's the matrix what to do with EndDate when StartDate/CovType
;agree, but EndDate does not:
;
; RPMS State Action
; ------------- ------------- ------
;(1) Value Blank None
;(2) Blank Value Update
;(3) Earlier Later Update
;(4) Later Earlier None
;
;Case (3) is when the RPMS EndDate is earlier than the State EndDate.
;EndDate will be updated to the later State EndDate. If the actual DOS
;falls between the EndDates, we'd miss the claim. This is somewhat
;inconsistent with (1).
;
;Case (4) is when the RPMS EndDate is later than the State EndDate.
;This is the conservative approach to process the claim, if the actual
;DOS is between the EndDates, with the assumption (hope) that the
;State's data is....lagging, or wrong, or something.
;
S AGBD=0
F S AGBD=$O(AG("DT",AGBD)) Q:'AGBD D I AGADD S AGUPDATE=0
. S AGCT=0
. F S AGCT=$O(AG("DT",AGBD,AGCT)) Q:AGCT="" D
.. I '$G(AG1("DT",AGBD,AGCT)) D ADD(AGBD,$P(AG("DT",AGBD,AGCT),U,2),AGCT) Q
.. ;Update EndDate if State has value, RPMS is blank.
.. I $P(AG("DT",AGBD,AGCT),U,2),'$P(AG1("DT",AGBD,AGCT),U,2) D EDIT(AG("DT",AGBD,AGCT)) Q
.. ;Update EndDate if State is LATER than RPMS.
.. I $P(AG("DT",AGBD,AGCT),U,2),$P(AG1("DT",AGBD,AGCT),U,2),$P(AG("DT",AGBD,AGCT),U,2)>$P(AG1("DT",AGBD,AGCT),U,2) D EDIT(AG("DT",AGBD,AGCT))
..Q
.Q
KILL AGBD,AGCT
I $G(AGUPDATE) D PTACT^AGELUP2(2,AG("DFN"))
D UPDATE(AG("DFN"),AG("IEN"))
Q
UPDATE(DFN,AGIEN) ;
NEW AG
S AG("MCD")=AGIEN
D UPDATE^AGED5
Q
ADD(X,AG2,AG3) ;
NEW DA,DIC,DR
S DA(1)=AG("IEN"),DIC="^AUPNMCD("_DA(1)_",11,",DIC(0)="F",DIC("P")=$P(^DD(9000004,1101,0),U,2)
KILL DD,DO
S DIC("DR")=$S(AG2:".02///"_AG2_";",1:"")_".03///"_AG3
D FILE^DICN
I +Y>0 S AGUPDATE=1
Q
EDIT(AGDATES) ;
NEW DA,DIE,DR
S DA=0
F S DA=$O(^AUPNMCD(AG("IEN"),11,DA)) Q:'DA I $P(AGDATES,U,1)=$P(^(DA,0),U,1),$P(AGDATES,U,3)=$P(^(0),U,3) Q
Q:'DA ;Something wrong happended, somewhere.
S DA(1)=AG("IEN"),DIE="^AUPNMCD("_DA(1)_",11,",DR=".02///"_$P(AGDATES,U,2)
D ^DIE
S AGUPDATE=1
Q
AGELUP4 ;IHS/SET/GTH - UPDATE ELIGIBILITY FROM FILE
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
D(AG) ;EP - process Medicaid
+1 ;See update matrix, in FILE subroutine.
+2 KILL AG1,AG2,AGSAME
+3 ;Check for -exact- match, -or- all Elig dates.
+4 IF $DATA(^AUPNMCD("AB",AG("DFN"),AGMCDST))
Begin DoDot:1
+5 SET AG("MNBR")=""
+6 FOR
SET AG("MNBR")=$ORDER(^AUPNMCD("AB",AG("DFN"),AGMCDST,AG("MNBR")))
IF '$LENGTH(AG("MNBR"))
QUIT
Begin DoDot:2
+7 SET AG("IEN")=0
+8 FOR
SET AG("IEN")=$ORDER(^AUPNMCD("AB",AG("DFN"),AGMCDST,AG("MNBR"),AG("IEN")))
IF 'AG("IEN")
QUIT
DO MCDY
IF AGSAME
SET AGACT="S"
QUIT
+9 QUIT
End DoDot:2
IF $GET(AGSAME)
QUIT
+10 QUIT
End DoDot:1
IF $GET(AGSAME)
QUIT
+11 ;Find most recent entry that matches demographic data (no dates).
+12 ;If found AG("IEN") will be it.
+13 IF $DATA(^AUPNMCD("AB",AG("DFN"),AGMCDST))
Begin DoDot:1
+14 SET AG("MNBR")=""
+15 FOR
SET AG("MNBR")=$ORDER(^AUPNMCD("AB",AG("DFN"),AGMCDST,AG("MNBR")),-1)
IF '$LENGTH(AG("MNBR"))
QUIT
Begin DoDot:2
+16 SET AG("IEN")=""
+17 FOR
SET AG("IEN")=$ORDER(^AUPNMCD("AB",AG("DFN"),AGMCDST,AG("MNBR"),AG("IEN")),-1)
IF 'AG("IEN")
QUIT
Begin DoDot:3
+18 ;MediCaid name.
+19 IF '(AG("FNM")=$PIECE($GET(^AUPNMCD(AG("IEN"),21)),U,1))
QUIT
+20 ;MediCaid DOB.
+21 IF '(AG("FDOB")=$PIECE($GET(^AUPNMCD(AG("IEN"),21)),U,2))
QUIT
+22 ;MediCaid Number.
+23 IF '(AG("FNBR")=$PIECE(^AUPNMCD(AG("IEN"),0),U,3))
IF '((+AG("FNBR"))=(+$PIECE(^AUPNMCD(AG("IEN"),0),U,3)))
QUIT
+24 SET AGSAME=1
+25 QUIT
End DoDot:3
IF $GET(AGSAME)
QUIT
+26 QUIT
End DoDot:2
IF $GET(AGSAME)
QUIT
+27 QUIT
End DoDot:1
+28 ;If demographic data does not match, but Pt has MCD entry,
+29 ;get highest IEN.
+30 IF '$GET(AG("IEN"))
IF $DATA(^AUPNMCD("AB",AG("DFN"),AGMCDST))
NEW I
Begin DoDot:1
+31 NEW N,T
+32 SET N=""
SET I=0
+33 FOR
SET N=$ORDER(^AUPNMCD("AB",AG("DFN"),AGMCDST,N))
IF '$LENGTH(N)
QUIT
SET T=$ORDER(^(N,0))
IF T>I
SET I=T
+34 QUIT
End DoDot:1
IF I
SET AG("IEN")=I
+35 ;Make sure Dif flags are set.
IF $GET(AG("IEN"))
DO MCDY
+36 IF AGAUTO'="A"
Begin DoDot:1
+37 DO HEAD^AGELUPUT("MEDICAID")
+38 IF '$DATA(^AUPNMCD("AB",AG("DFN"),AGMCDST))
DO MCDN
+39 DO MDISP^AGELUP2(5)
DO PEND^AGELUPUT
+40 QUIT
End DoDot:1
QUIT
+41 USE IO(0)
+42 WRITE "."
+43 IF '(AGRCNT#100)
WRITE $JUSTIFY(AGRCNT,8)
+44 QUIT
MCDY ;if medicaid coverage
+1 SET AGSAME=0
+2 ;MediCaid name.
+3 SET (AGMNM,AG1(1))=$PIECE($GET(^AUPNMCD(AG("IEN"),21)),U)
+4 ;MediCaid DOB.
+5 SET AGMDOB=$PIECE($GET(^AUPNMCD(AG("IEN"),21)),U,2)
+6 SET AG1(2)=AGMDOB
+7 ;MediCaid Number.
+8 SET (AGMNBR,AG1(3))=$PIECE(^AUPNMCD(AG("IEN"),0),U,3)
+9 SET AG1(4)=""
+10 ;AG1("DT",EligDt,CovType)=EligDt^ELigEndDt^CovType
+11 SET DA=0
+12 FOR
SET DA=$ORDER(^AUPNMCD(AG("IEN"),11,DA))
IF 'DA
QUIT
SET %=^(DA,0)
IF $PIECE(%,U,3)=""
SET $PIECE(%,U,3)=" "
SET AG1("DT",$PIECE(%,U,1),$PIECE(%,U,3))=%
+13 KILL AGFL
+14 DO DFL
+15 IF '$DATA(AGFL)
SET AGSAME=1
+16 QUIT
MCDN ;EP - No MCD coverage in rpms.
+1 SET AG1(1)="NO ELIGIBILITY ON FILE"
+2 FOR I=2:1:4
SET AG1(I)=""
+3 DO DFL
+4 QUIT
DFL ;EP - Set descrepency flags.
+1 KILL AGFL
+2 ;M/M Name.
+3 SET AG2(1)=$GET(AG("FNM"))
+4 IF AG2(1)'=$GET(AGMNM)
SET AGFL(1)=1
+5 ;DOB.
+6 SET AG2(2)=$GET(AG("FDOB"))
+7 IF AG2(2)'=$GET(AGMDOB)
SET AGFL(2)=1
+8 ;Number. Check for leading 0's.
+9 SET AG2(3)=$GET(AG("FNBR"))
+10 IF '(AG2(3)=$GET(AGMNBR))
IF '((+AG2(3))=(+$GET(AGMNBR)))
SET AGFL(3)=1
+11 ;Prevent UNDEF.
SET AG2(4)=""
+12 ;Compare file eligibilities with existing eligibilities.
+13 ;AG1("DT",EligDt,CovType)=EligDt^ELigEndDt^CovType
+14 ;Make the comparison based on the update matrix in FILE(), below.
+15 ;AG("DT",,) contains the State data.
+16 NEW I,J
+17 SET I=0
+18 FOR
SET I=$ORDER(AG("DT",I))
IF 'I
QUIT
Begin DoDot:1
+19 SET J=0
+20 FOR
SET J=$ORDER(AG("DT",I,J))
IF J=""
QUIT
Begin DoDot:2
+21 IF '$GET(AG1("DT",I,J))
SET AGFL(5)=1
QUIT
+22 IF AG1("DT",I,J)=AG("DT",I,J)
QUIT
+23 ;State EndDate is blank.
IF $PIECE(AG("DT",I,J),U,2)=""
QUIT
+24 IF $PIECE(AG1("DT",I,J),U,2)>$PIECE(AG("DT",I,J),U,2)
QUIT
+25 SET AGFL(5)=1
+26 QUIT
End DoDot:2
+27 QUIT
End DoDot:1
+28 ;AG1("DT",,) contains RPMS data.
+29 SET I=0
+30 FOR
SET I=$ORDER(AG1("DT",I))
IF 'I
QUIT
Begin DoDot:1
+31 SET J=0
+32 FOR
SET J=$ORDER(AG1("DT",I,J))
IF J=""
QUIT
Begin DoDot:2
+33 ;Exists in RPMS but not in STATE.
IF '$DATA(AG("DT",I,U))
QUIT
+34 ;State EndDate is blank.
IF $PIECE(AG("DT",I,J),U,2)=""
QUIT
+35 IF $PIECE(AG1("DT",I,J),U,2)>$PIECE(AG("DT",I,J),U,2)
QUIT
+36 SET AGFL(5)=1
+37 QUIT
End DoDot:2
+38 QUIT
End DoDot:1
+39 QUIT
FILE(AG) ;EP - File Medicaid
+1 NEW AGADD,AGUPDATE
+2 IF '$GET(AG("IEN"))
Begin DoDot:1
+3 NEW DIC,DLAYGO,DD,DO
+4 IF '("MF"[AG("FSEX"))
SET AG("FSEX")=""
+5 SET DIC="^AUPNMCD("
SET DIC(0)="F"
SET DLAYGO=9000004
SET X=AG("DFN")
+6 SET DIC("DR")=".02////"_AGINSPT_";.03///"_AG("FNBR")_";.04////"_AGMCDST_$SELECT($LENGTH(AG("FSEX")):";.07///"_AG("FSEX"),1:"")_";.08////"_DT_";2101///"_AG("FNM")_";2102///"_AG("FDOB")
+7 DO FILE^DICN
+8 IF +Y>0
SET AG("IEN")=+Y
DO PTACT^AGELUP2(1,AG("DFN"))
+9 QUIT
End DoDot:1
IF +Y<0
QUIT
SET AGADD=1
IF 1
+10 IF '$TEST
Begin DoDot:1
+11 NEW DA,DIE,DR
+12 SET DIE="^AUPNMCD("
SET DA=AG("IEN")
SET DR=""
+13 IF $PIECE(^AUPNMCD(DA,0),U,2)'=AGINSPT
SET DR=".02////"_AGINSPT
+14 IF AG("FNBR")'=""
IF AG("FNBR")'=$PIECE(^AUPNMCD(DA,0),U,3)
SET DR=DR_$SELECT($LENGTH(DR):";",1:"")_".03///"_AG("FNBR")
+15 IF AG("FSEX")'=""
IF AG("FSEX")'=$PIECE(^AUPNMCD(DA,0),U,7)
SET DR=DR_$SELECT($LENGTH(DR):";",1:"")_".07///"_AG("FSEX")
+16 IF AG("FNM")'=""
IF AG("FNM")'=$PIECE($GET(^AUPNMCD(DA,21)),U)
SET DR=DR_$SELECT($LENGTH(DR):";",1:"")_"2101///"_AG("FNM")
+17 IF AG("FDOB")'=""
IF AG("FDOB")'=$PIECE($GET(^AUPNMCD(DA,21)),U,2)
SET DR=DR_$SELECT($LENGTH(DR):";",1:"")_"2102////"_AG("FDOB")
+18 IF $LENGTH(DR)
NEW DITC
SET DITC=""
SET DR=DR_";.08////"_DT
DO ^DIE
IF '$DATA(Y)
DO PTACT^AGELUP2(2,AG("DFN"))
KILL DITC
+19 QUIT
End DoDot:1
SET AGADD=0
+20 ;Here's the matrix what to do with EndDate when StartDate/CovType
+21 ;agree, but EndDate does not:
+22 ;
+23 ; RPMS State Action
+24 ; ------------- ------------- ------
+25 ;(1) Value Blank None
+26 ;(2) Blank Value Update
+27 ;(3) Earlier Later Update
+28 ;(4) Later Earlier None
+29 ;
+30 ;Case (3) is when the RPMS EndDate is earlier than the State EndDate.
+31 ;EndDate will be updated to the later State EndDate. If the actual DOS
+32 ;falls between the EndDates, we'd miss the claim. This is somewhat
+33 ;inconsistent with (1).
+34 ;
+35 ;Case (4) is when the RPMS EndDate is later than the State EndDate.
+36 ;This is the conservative approach to process the claim, if the actual
+37 ;DOS is between the EndDates, with the assumption (hope) that the
+38 ;State's data is....lagging, or wrong, or something.
+39 ;
+40 SET AGBD=0
+41 FOR
SET AGBD=$ORDER(AG("DT",AGBD))
IF 'AGBD
QUIT
Begin DoDot:1
+42 SET AGCT=0
+43 FOR
SET AGCT=$ORDER(AG("DT",AGBD,AGCT))
IF AGCT=""
QUIT
Begin DoDot:2
+44 IF '$GET(AG1("DT",AGBD,AGCT))
DO ADD(AGBD,$PIECE(AG("DT",AGBD,AGCT),U,2),AGCT)
QUIT
+45 ;Update EndDate if State has value, RPMS is blank.
+46 IF $PIECE(AG("DT",AGBD,AGCT),U,2)
IF '$PIECE(AG1("DT",AGBD,AGCT),U,2)
DO EDIT(AG("DT",AGBD,AGCT))
QUIT
+47 ;Update EndDate if State is LATER than RPMS.
+48 IF $PIECE(AG("DT",AGBD,AGCT),U,2)
IF $PIECE(AG1("DT",AGBD,AGCT),U,2)
IF $PIECE(AG("DT",AGBD,AGCT),U,2)>$PIECE(AG1("DT",AGBD,AGCT),U,2)
DO EDIT(AG("DT",AGBD,AGCT))
+49 QUIT
End DoDot:2
+50 QUIT
End DoDot:1
IF AGADD
SET AGUPDATE=0
+51 KILL AGBD,AGCT
+52 IF $GET(AGUPDATE)
DO PTACT^AGELUP2(2,AG("DFN"))
+53 DO UPDATE(AG("DFN"),AG("IEN"))
+54 QUIT
UPDATE(DFN,AGIEN) ;
+1 NEW AG
+2 SET AG("MCD")=AGIEN
+3 DO UPDATE^AGED5
+4 QUIT
ADD(X,AG2,AG3) ;
+1 NEW DA,DIC,DR
+2 SET DA(1)=AG("IEN")
SET DIC="^AUPNMCD("_DA(1)_",11,"
SET DIC(0)="F"
SET DIC("P")=$PIECE(^DD(9000004,1101,0),U,2)
+3 KILL DD,DO
+4 SET DIC("DR")=$SELECT(AG2:".02///"_AG2_";",1:"")_".03///"_AG3
+5 DO FILE^DICN
+6 IF +Y>0
SET AGUPDATE=1
+7 QUIT
EDIT(AGDATES) ;
+1 NEW DA,DIE,DR
+2 SET DA=0
+3 FOR
SET DA=$ORDER(^AUPNMCD(AG("IEN"),11,DA))
IF 'DA
QUIT
IF $PIECE(AGDATES,U,1)=$PIECE(^(DA,0),U,1)
IF $PIECE(AGDATES,U,3)=$PIECE(^(0),U,3)
QUIT
+4 ;Something wrong happended, somewhere.
IF 'DA
QUIT
+5 SET DA(1)=AG("IEN")
SET DIE="^AUPNMCD("_DA(1)_",11,"
SET DR=".02///"_$PIECE(AGDATES,U,2)
+6 DO ^DIE
+7 SET AGUPDATE=1
+8 QUIT
