ABMPPAD1 ; IHS/SD/SDR - Prior Payments/Adjustments page (CE);
;;2.6;IHS 3P BILLING SYSTEM;**6,8,21**;NOV 12, 2009;Build 379
;
; IHS/SD/SDR - v2.5 p12 - IM25430
; Made correction for <SUBSCR>EDIT2+3^ABMPPAD1
;
;IHS/SD/SDR - v2.5 p13 - NO IM
;IHS/SD/SDR - abm*2.6*6 - 5010 - added export mode 32
;IHS/SD/SDR - 2.6*21 - HEAT176726 - ABMILST wasn't always define when trying to edit an entry; added to code to create array if it wasn't already defined.
;
Q
DISPCK ;EP
;I ABMP("EXP")'=21&(ABMP("EXP")'=22)&(ABMP("EXP")'=23) S ABMCHK=1 Q ;must be 837 ;abm*2.6*6 5010
;I ABMP("EXP")'=21&(ABMP("EXP")'=22)&(ABMP("EXP")'=23)&(ABMP("EXP")'=32) S ABMCHK=1 Q ;must be 837 ;abm*2.6*6 5010 ;abm*2.6*8 5010
I ABMP("EXP")'=21&(ABMP("EXP")'=22)&(ABMP("EXP")'=23)&(ABMP("EXP")'=31)&(ABMP("EXP")'=32)&(ABMP("EXP")'=33) S ABMCHK=1 Q ;must be 837 ;abm*2.6*6 5010 ;abm*2.6*8 5010
S ABMCHK=0
S ABMEXPM=0
K ABMEXPMS,ABMSFLG,ABMP("OBAMT")
F S ABMEXPM=$O(ABMP("EXP",ABMEXPM)) Q:+ABMEXPM=0 D
.I $G(ABMEXPMS)="" S ABMEXPMS=ABMEXPM
.I $G(ABMEXPMS)'="",(ABMEXPMS'=ABMEXPM) S ABMCHK=1
S ABM("CLM")=ABMP("CDFN")
S ABM("A")="B"
F S ABM("A")=$O(^ABMDBILL(DUZ(2),"AS",ABM("CLM"),ABM("A"))) Q:ABM("A")=""!(ABM("A")'="C") D
.F ABM=0:0 S ABM=$O(^ABMDBILL(DUZ(2),"AS",ABM("CLM"),ABM("A"),ABM)) Q:'ABM D
..Q:$P($G(^ABMDBILL(DUZ(2),ABM,0)),U,5)'=ABMP("PDFN")
..S:(+$G(ABMP("OBAMT"))=0) ABMP("OBAMT")=$P($G(^ABMDBILL(DUZ(2),ABM,2)),U)
I +$G(ABMP("OBAMT"))=0 S ABMCHK=1
Q
SETVAR ;EP
S (ABMPM("PD"),ABMPM("DED"),ABMPM("TOT"))=0
S (ABMPM("COI"),ABMPM("WO"),ABMPM("NONC"))=0
S (ABMPM("PENS"),ABMPM("GRP"),ABMPM("REF"))=0
S ABMPM("PCR")=0
Q
ADD ;EP
W !!
S DIR(0)="NO^1:"_ABMPRIS
S DIR("A")="Which insurer are you editing"
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S ABMEFLG=1 Q
I '$D(ABMPL(+Y)) W !,"No insurer at that entry" H 2 S ABMEFLG=1 Q
S ABMIIEN=$O(ABMPL(+Y,0))
I $P(ABMPL(+Y,ABMIIEN),U,2)="I" W !,"Cannot add/edit the active insurer!" H 2 S ABMEFLG=1 Q
W !,"Ok, let's edit ",$P($G(^AUTNINS(ABMIIEN,0)),U),!
S DIR(0)="SO^P:PAYMENT;A:ADJUSTMENT"
S DIR("A")="Adding a Payment or Adjustment"
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S ABMEFLG=1 Q
S ABMCAT=Y
S (ABMPPIEN,ABMLN,ABMLNSV)=+$G(ABMLNSV)+1
S ABMPP(ABMIIEN,ABMCAT,ABMLN)=""
Q
EDIT ;EP
W !!
K ABMEFLG
S DIR(0)="NO^1:"_ABMPRIS
S DIR("A")="Which insurer are you editing"
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S ABMEFLG=1 Q
I '$D(ABMPL(+Y)) W !,"No insurer at that entry" H 2 S ABMEFLG=1 Q
S ABMIIEN=$O(ABMPL(+Y,0))
I $P(ABMPL(+Y,ABMIIEN),U,2)="I"!($P(ABMPL(+Y,ABMIIEN),U,2)="P") W !,"Cannot add/edit the active/pending insurer!" H 2 S ABMEFLG=1 Q
W !,"Ok, let's edit ",$P($G(^AUTNINS(ABMIIEN,0)),U),!
;start new abm*2.6*6 5010
D ^XBFMK
;start new abm*2.6*21 IHS/SD/SDR HEAT176726
I +$O(ABMILST(ABMIIEN,0))=0 D
.F S ABMBSTA=$O(^ABMDBILL(DUZ(2),"AS",ABMP("CDFN"),ABMBSTA)) Q:ABMBSTA="" D
..Q:ABMBSTA="X"
..S ABMBFIEN=0
..F S ABMBFIEN=$O(^ABMDBILL(DUZ(2),"AS",ABMP("CDFN"),ABMBSTA,ABMBFIEN)) Q:+ABMBFIEN=0 D
...S ABMBNUM=$P($G(^ABMDBILL(DUZ(2),ABMBFIEN,0)),U)
....S ABMLN=+$G(ABMLN)+1
....S ABMBINS=$P($G(^ABMDBILL(DUZ(2),ABMBFIEN,0)),U,8)
....S ABMILST(ABMBINS,ABMBFIEN)=""
;end new abm*2.6*21 IHS/SD/SDR HEAT176726
S DA(1)=$O(ABMILST(ABMIIEN,0))
S DIE="^ABMDBILL(DUZ(2),"_DA(1)_",13,"
S DA=ABMIIEN
S DR=".12//"
D ^DIE
;end new code 5010
S ABMCAT=""
F S ABMCAT=$O(ABMPP(ABMIIEN,ABMCAT),-1) Q:ABMCAT="" D
.S ABMLN=0
.F S ABMLN=$O(ABMPP(ABMIIEN,ABMCAT,ABMLN)) Q:+ABMLN=0 D
..I $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U)=0 K ABMPP(ABMIIEN,ABMCAT,ABMLN) Q
..W !?2,"["_ABMLN_"] "
..I ABMCAT="P" W "PAYMENT ",$J(ABMPP(ABMIIEN,ABMCAT,ABMLN),10,2)
..I ABMCAT="A" D
...W "ADJUSTMENT ",$J($P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U),10,2)
...I $P($G(ABMPP(ABMIIEN,ABMCAT,ABMLN)),U,2)'="" W ?30,"[",$P($G(ABMPP(ABMIIEN,ABMCAT,ABMLN)),U,2),"]",$E($P($G(^BAR(90052.01,$P($G(ABMPP(ABMIIEN,ABMCAT,ABMLN)),U,2),0)),U),1,18)
...I $P($G(ABMPP(ABMIIEN,ABMCAT,ABMLN)),U,3)'="" W ?50,"[",$P($G(ABMPP(ABMIIEN,ABMCAT,ABMLN)),U,3),"]",$E($P($G(^BARTBL($P($G(ABMPP(ABMIIEN,ABMCAT,ABMLN)),U,3),0)),U),1,18)
...I $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,4)'="" W ?75,"[",$P(^BARADJ($P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,4),0),U),"]"
I +$G(ABMLNSV)=0 W !,"Must use Add because there are no transactions to edit!" H 2 S ABMEFLG=1 Q
S DIR(0)="NO^1:"_ABMLNSV
S DIR("A")="Which transaction"
D ^DIR K DIR,ABMLNPK
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S ABMEFLG=1 Q
S ABMPPIEN=+Y
Q:'$D(ABMPP(ABMIIEN,"P",ABMPPIEN))&'$D(ABMPP(ABMIIEN,"A",ABMPPIEN))
S ABMCAT=""
K ABMLFLG,ABMDIF
F S ABMCAT=$O(ABMPP(ABMIIEN,ABMCAT)) Q:ABMCAT="" D Q:($G(ABMLFLG)=1)
.S ABMLN=0
.F S ABMLN=$O(ABMPP(ABMIIEN,ABMCAT,ABMLN)) Q:+ABMLN=0 D Q:($G(ABMLFLG)=1)
..I ABMLN=ABMPPIEN S ABMLFLG=1
Q
EDIT2 ;EP
S DIR(0)="NO^-99999.99:99999.99:2"
S DIR("A")="AMOUNT"
I $P(ABMPP(ABMIIEN,ABMCAT,ABMPPIEN),U)'=0 S DIR("B")=$P(ABMPP(ABMIIEN,ABMCAT,ABMPPIEN),U)
D ^DIR K DIR
S ABMAMT=+Y
S ABMDIF=$P(ABMPP(ABMIIEN,ABMCAT,ABMPPIEN),U)-ABMAMT
S ABMOAMT=$P(ABMPP(ABMIIEN,ABMCAT,ABMPPIEN),U)
S $P(ABMPP(ABMIIEN,ABMCAT,ABMPPIEN),U)=+Y
I ABMCAT="P" D
.S ABMPM("PD")=+$G(ABMPM("PD"))-(ABMDIF)
I ABMCAT="A" D
.I ABMAMT=0 D Q
..S ABMADJC=$P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)
..I ABMADJC=3 S ABMPM("WO")=+ABMPM("WO")-ABMOAMT
..I ABMADJC=4 S ABMPM("NONC")=+ABMPM("NONC")-ABMOAMT
..I ABMADJC=13 S ABMPM("DED")=+ABMPM("DED")-ABMOAMT
..I ABMADJC=14 S ABMPM("COI")=+ABMPM("COI")-ABMOAMT
..I ABMADJC=15 S ABMPM("PENS")=+ABMPM("PENS")-ABMOAMT
..I ABMADJC=16 S ABMPM("GRP")=+ABMPM("GRP")-ABMOAMT
..I ABMADJC=19 S ABMPM("REF")=+ABMPM("REF")-ABMOAMT
..I ABMADJC=20 S ABMPM("PCR")=+ABMPM("PCR")-ABMOAMT
..S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)=""
..S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,3)=""
..S ABMOFLG=1
.I $G(ABMOFLG)=1 K ABMOFLG Q
.K DIR,Y,X
.S DIR(0)="PO^90052.01^W "" ""_$P($G(^BAR(90052.01,+Y,0)),U)"
.S DIR("S")="I "",3,4,13,14,15,16,20,21,22,""[("",""_Y_"","")"
.S DIR("A")="ADJUSTMENT CATEGORY"
.I $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)'="" S DIR("B")=$P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)
.D ^DIR K DIR
.I Y<0,X="@" S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)=""
.;
.I Y>0 D
..S ABMADJC=$P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)
..I ABMADJC=3 S ABMPM("WO")=+ABMPM("WO")-ABMOAMT
..I ABMADJC=4 S ABMPM("NONC")=+ABMPM("NONC")-ABMOAMT
..I ABMADJC=13 S ABMPM("DED")=+ABMPM("DED")-ABMOAMT
..I ABMADJC=14 S ABMPM("COI")=+ABMPM("COI")-ABMOAMT
..I ABMADJC=15 S ABMPM("PENS")=+ABMPM("PENS")-ABMOAMT
..I ABMADJC=16 S ABMPM("GRP")=+ABMPM("GRP")-ABMOAMT
..I ABMADJC=19 S ABMPM("REF")=+ABMPM("REF")-ABMOAMT
..I ABMADJC=20 S ABMPM("PCR")=+ABMPM("PCR")-ABMOAMT
..;
..I +Y=3 S ABMPM("WO")=+ABMPM("WO")+ABMAMT
..I +Y=4 S ABMPM("NONC")=+ABMPM("NONC")+ABMAMT
..I +Y=13 S ABMPM("DED")=+ABMPM("DED")+ABMAMT
..I +Y=14 S ABMPM("COI")=+ABMPM("COI")+ABMAMT
..I +Y=15 S ABMPM("PENS")=+ABMPM("PENS")+ABMAMT
..I +Y=16 S ABMPM("GRP")=+ABMPM("GRP")+ABMAMT
..I +Y=19 S ABMPM("REF")=+ABMPM("REF")+ABMAMT
..I +Y=20 S ABMPM("PCR")=+ABMPM("PCR")+ABMAMT
..;
..S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)=+Y,ABMADJC=+Y
.K DIR,Y,X
.S DIR(0)="PO^90052.02^W "" ""_$P($G(^BARTBL(+Y,0)),U)"
.S DIR("S")="I $P(^(0),U,2)=ABMADJC"
.S DIR("A")="ADJUSTMENT REASON"
.I $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,3)'="" S DIR("B")=$P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,3)
.D ^DIR K DIR
.I Y<0,X="@" S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,3)=""
.I Y>0 S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,3)=+Y
.K DIR,Y,X
.S DIR(0)="PO^90056.06"
.S DIR("A")="STANDARD REASON"
.I $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,4)'="" S DIR("B")=$P(^BARADJ($P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,4),0),U)
.D ^DIR K DIR
.I Y<0,X="@" S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,4)=""
.I Y>0 S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,4)=+Y
.S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,5)="" ;delete any info for billable
.I $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)'=13&($P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)'=14)&($P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)'=21)&($P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)'=22) D
..K DIR,X,Y
..S DIR(0)="Y"
..S DIR("B")="Y"
..S DIR("A")="Do you want to include in secondary balance"
..D ^DIR K DIR
..I Y>0 S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,5)="Y"
.I ($P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)=21)!($P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)=22) S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,5)="N"
I $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)=13!($P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)=14) S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,5)="Y"
Q
XIT ;EP
I +$G(ABMSFLG)=0 D EN^ABMPPFLR ;this files changes into pymt multiple
S ABMP("C0")=$G(ABMDCLM(DUZ(2),ABMP("CDFN"),0))
K ABM,ABMV,ABME,ABMPL,ABMPRIS
K ABMSTAT,ABMPR,ABMIIEN,ABMINS,ABMLN,ABMCAT,ABMTTYP,ABMCAT
K ABMLAMT,ABMLNSV,ABMOPDT,DR,DIC,DIE
K ABMPREC
S ABMP("SCRN")=0
S (ABMP("TOT"),ABMS("TOT"))=ABMPM("TOT")
S ABMP("EXP",ABMP("EXP"))=ABMPM("TOT")
Q
ABMPPAD1 ; IHS/SD/SDR - Prior Payments/Adjustments page (CE);
+1 ;;2.6;IHS 3P BILLING SYSTEM;**6,8,21**;NOV 12, 2009;Build 379
+2 ;
+3 ; IHS/SD/SDR - v2.5 p12 - IM25430
+4 ; Made correction for <SUBSCR>EDIT2+3^ABMPPAD1
+5 ;
+6 ;IHS/SD/SDR - v2.5 p13 - NO IM
+7 ;IHS/SD/SDR - abm*2.6*6 - 5010 - added export mode 32
+8 ;IHS/SD/SDR - 2.6*21 - HEAT176726 - ABMILST wasn't always define when trying to edit an entry; added to code to create array if it wasn't already defined.
+9 ;
+10 QUIT
DISPCK ;EP
+1 ;I ABMP("EXP")'=21&(ABMP("EXP")'=22)&(ABMP("EXP")'=23) S ABMCHK=1 Q ;must be 837 ;abm*2.6*6 5010
+2 ;I ABMP("EXP")'=21&(ABMP("EXP")'=22)&(ABMP("EXP")'=23)&(ABMP("EXP")'=32) S ABMCHK=1 Q ;must be 837 ;abm*2.6*6 5010 ;abm*2.6*8 5010
+3 ;must be 837 ;abm*2.6*6 5010 ;abm*2.6*8 5010
IF ABMP("EXP")'=21&(ABMP("EXP")'=22)&(ABMP("EXP")'=23)&(ABMP("EXP")'=31)&(ABMP("EXP")'=32)&(ABMP("EXP")'=33)
SET ABMCHK=1
QUIT
+4 SET ABMCHK=0
+5 SET ABMEXPM=0
+6 KILL ABMEXPMS,ABMSFLG,ABMP("OBAMT")
+7 FOR
SET ABMEXPM=$ORDER(ABMP("EXP",ABMEXPM))
IF +ABMEXPM=0
QUIT
Begin DoDot:1
+8 IF $GET(ABMEXPMS)=""
SET ABMEXPMS=ABMEXPM
+9 IF $GET(ABMEXPMS)'=""
IF (ABMEXPMS'=ABMEXPM)
SET ABMCHK=1
End DoDot:1
+10 SET ABM("CLM")=ABMP("CDFN")
+11 SET ABM("A")="B"
+12 FOR
SET ABM("A")=$ORDER(^ABMDBILL(DUZ(2),"AS",ABM("CLM"),ABM("A")))
IF ABM("A")=""!(ABM("A")'="C")
QUIT
Begin DoDot:1
+13 FOR ABM=0:0
SET ABM=$ORDER(^ABMDBILL(DUZ(2),"AS",ABM("CLM"),ABM("A"),ABM))
IF 'ABM
QUIT
Begin DoDot:2
+14 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABM,0)),U,5)'=ABMP("PDFN")
QUIT
+15 IF (+$GET(ABMP("OBAMT"))=0)
SET ABMP("OBAMT")=$PIECE($GET(^ABMDBILL(DUZ(2),ABM,2)),U)
End DoDot:2
End DoDot:1
+16 IF +$GET(ABMP("OBAMT"))=0
SET ABMCHK=1
+17 QUIT
SETVAR ;EP
+1 SET (ABMPM("PD"),ABMPM("DED"),ABMPM("TOT"))=0
+2 SET (ABMPM("COI"),ABMPM("WO"),ABMPM("NONC"))=0
+3 SET (ABMPM("PENS"),ABMPM("GRP"),ABMPM("REF"))=0
+4 SET ABMPM("PCR")=0
+5 QUIT
ADD ;EP
+1 WRITE !!
+2 SET DIR(0)="NO^1:"_ABMPRIS
+3 SET DIR("A")="Which insurer are you editing"
+4 DO ^DIR
KILL DIR
+5 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
SET ABMEFLG=1
QUIT
+6 IF '$DATA(ABMPL(+Y))
WRITE !,"No insurer at that entry"
HANG 2
SET ABMEFLG=1
QUIT
+7 SET ABMIIEN=$ORDER(ABMPL(+Y,0))
+8 IF $PIECE(ABMPL(+Y,ABMIIEN),U,2)="I"
WRITE !,"Cannot add/edit the active insurer!"
HANG 2
SET ABMEFLG=1
QUIT
+9 WRITE !,"Ok, let's edit ",$PIECE($GET(^AUTNINS(ABMIIEN,0)),U),!
+10 SET DIR(0)="SO^P:PAYMENT;A:ADJUSTMENT"
+11 SET DIR("A")="Adding a Payment or Adjustment"
+12 DO ^DIR
KILL DIR
+13 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
SET ABMEFLG=1
QUIT
+14 SET ABMCAT=Y
+15 SET (ABMPPIEN,ABMLN,ABMLNSV)=+$GET(ABMLNSV)+1
+16 SET ABMPP(ABMIIEN,ABMCAT,ABMLN)=""
+17 QUIT
EDIT ;EP
+1 WRITE !!
+2 KILL ABMEFLG
+3 SET DIR(0)="NO^1:"_ABMPRIS
+4 SET DIR("A")="Which insurer are you editing"
+5 DO ^DIR
KILL DIR
+6 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
SET ABMEFLG=1
QUIT
+7 IF '$DATA(ABMPL(+Y))
WRITE !,"No insurer at that entry"
HANG 2
SET ABMEFLG=1
QUIT
+8 SET ABMIIEN=$ORDER(ABMPL(+Y,0))
+9 IF $PIECE(ABMPL(+Y,ABMIIEN),U,2)="I"!($PIECE(ABMPL(+Y,ABMIIEN),U,2)="P")
WRITE !,"Cannot add/edit the active/pending insurer!"
HANG 2
SET ABMEFLG=1
QUIT
+10 WRITE !,"Ok, let's edit ",$PIECE($GET(^AUTNINS(ABMIIEN,0)),U),!
+11 ;start new abm*2.6*6 5010
+12 DO ^XBFMK
+13 ;start new abm*2.6*21 IHS/SD/SDR HEAT176726
+14 IF +$ORDER(ABMILST(ABMIIEN,0))=0
Begin DoDot:1
+15 FOR
SET ABMBSTA=$ORDER(^ABMDBILL(DUZ(2),"AS",ABMP("CDFN"),ABMBSTA))
IF ABMBSTA=""
QUIT
Begin DoDot:2
+16 IF ABMBSTA="X"
QUIT
+17 SET ABMBFIEN=0
+18 FOR
SET ABMBFIEN=$ORDER(^ABMDBILL(DUZ(2),"AS",ABMP("CDFN"),ABMBSTA,ABMBFIEN))
IF +ABMBFIEN=0
QUIT
Begin DoDot:3
+19 SET ABMBNUM=$PIECE($GET(^ABMDBILL(DUZ(2),ABMBFIEN,0)),U)
+20 SET ABMLN=+$GET(ABMLN)+1
+21 SET ABMBINS=$PIECE($GET(^ABMDBILL(DUZ(2),ABMBFIEN,0)),U,8)
+22 SET ABMILST(ABMBINS,ABMBFIEN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+23 ;end new abm*2.6*21 IHS/SD/SDR HEAT176726
+24 SET DA(1)=$ORDER(ABMILST(ABMIIEN,0))
+25 SET DIE="^ABMDBILL(DUZ(2),"_DA(1)_",13,"
+26 SET DA=ABMIIEN
+27 SET DR=".12//"
+28 DO ^DIE
+29 ;end new code 5010
+30 SET ABMCAT=""
+31 FOR
SET ABMCAT=$ORDER(ABMPP(ABMIIEN,ABMCAT),-1)
IF ABMCAT=""
QUIT
Begin DoDot:1
+32 SET ABMLN=0
+33 FOR
SET ABMLN=$ORDER(ABMPP(ABMIIEN,ABMCAT,ABMLN))
IF +ABMLN=0
QUIT
Begin DoDot:2
+34 IF $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U)=0
KILL ABMPP(ABMIIEN,ABMCAT,ABMLN)
QUIT
+35 WRITE !?2,"["_ABMLN_"] "
+36 IF ABMCAT="P"
WRITE "PAYMENT ",$JUSTIFY(ABMPP(ABMIIEN,ABMCAT,ABMLN),10,2)
+37 IF ABMCAT="A"
Begin DoDot:3
+38 WRITE "ADJUSTMENT ",$JUSTIFY($PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U),10,2)
+39 IF $PIECE($GET(ABMPP(ABMIIEN,ABMCAT,ABMLN)),U,2)'=""
WRITE ?30,"[",$PIECE($GET(ABMPP(ABMIIEN,ABMCAT,ABMLN)),U,2),"]",$EXTRACT($PIECE($GET(^BAR(90052.01,$PIECE($GET(ABMPP(ABMIIEN,ABMCAT,ABMLN)),U,2),0)),U),1,18)
+40 IF $PIECE($GET(ABMPP(ABMIIEN,ABMCAT,ABMLN)),U,3)'=""
WRITE ?50,"[",$PIECE($GET(ABMPP(ABMIIEN,ABMCAT,ABMLN)),U,3),"]",$EXTRACT($PIECE($GET(^BARTBL($PIECE($GET(ABMPP(ABMIIEN,ABMCAT,ABMLN)),U,3),0)),U),1,18)
+41 IF $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,4)'=""
WRITE ?75,"[",$PIECE(^BARADJ($PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,4),0),U),"]"
End DoDot:3
End DoDot:2
End DoDot:1
+42 IF +$GET(ABMLNSV)=0
WRITE !,"Must use Add because there are no transactions to edit!"
HANG 2
SET ABMEFLG=1
QUIT
+43 SET DIR(0)="NO^1:"_ABMLNSV
+44 SET DIR("A")="Which transaction"
+45 DO ^DIR
KILL DIR,ABMLNPK
+46 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
SET ABMEFLG=1
QUIT
+47 SET ABMPPIEN=+Y
+48 IF '$DATA(ABMPP(ABMIIEN,"P",ABMPPIEN))&'$DATA(ABMPP(ABMIIEN,"A",ABMPPIEN))
QUIT
+49 SET ABMCAT=""
+50 KILL ABMLFLG,ABMDIF
+51 FOR
SET ABMCAT=$ORDER(ABMPP(ABMIIEN,ABMCAT))
IF ABMCAT=""
QUIT
Begin DoDot:1
+52 SET ABMLN=0
+53 FOR
SET ABMLN=$ORDER(ABMPP(ABMIIEN,ABMCAT,ABMLN))
IF +ABMLN=0
QUIT
Begin DoDot:2
+54 IF ABMLN=ABMPPIEN
SET ABMLFLG=1
End DoDot:2
IF ($GET(ABMLFLG)=1)
QUIT
End DoDot:1
IF ($GET(ABMLFLG)=1)
QUIT
+55 QUIT
EDIT2 ;EP
+1 SET DIR(0)="NO^-99999.99:99999.99:2"
+2 SET DIR("A")="AMOUNT"
+3 IF $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMPPIEN),U)'=0
SET DIR("B")=$PIECE(ABMPP(ABMIIEN,ABMCAT,ABMPPIEN),U)
+4 DO ^DIR
KILL DIR
+5 SET ABMAMT=+Y
+6 SET ABMDIF=$PIECE(ABMPP(ABMIIEN,ABMCAT,ABMPPIEN),U)-ABMAMT
+7 SET ABMOAMT=$PIECE(ABMPP(ABMIIEN,ABMCAT,ABMPPIEN),U)
+8 SET $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMPPIEN),U)=+Y
+9 IF ABMCAT="P"
Begin DoDot:1
+10 SET ABMPM("PD")=+$GET(ABMPM("PD"))-(ABMDIF)
End DoDot:1
+11 IF ABMCAT="A"
Begin DoDot:1
+12 IF ABMAMT=0
Begin DoDot:2
+13 SET ABMADJC=$PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)
+14 IF ABMADJC=3
SET ABMPM("WO")=+ABMPM("WO")-ABMOAMT
+15 IF ABMADJC=4
SET ABMPM("NONC")=+ABMPM("NONC")-ABMOAMT
+16 IF ABMADJC=13
SET ABMPM("DED")=+ABMPM("DED")-ABMOAMT
+17 IF ABMADJC=14
SET ABMPM("COI")=+ABMPM("COI")-ABMOAMT
+18 IF ABMADJC=15
SET ABMPM("PENS")=+ABMPM("PENS")-ABMOAMT
+19 IF ABMADJC=16
SET ABMPM("GRP")=+ABMPM("GRP")-ABMOAMT
+20 IF ABMADJC=19
SET ABMPM("REF")=+ABMPM("REF")-ABMOAMT
+21 IF ABMADJC=20
SET ABMPM("PCR")=+ABMPM("PCR")-ABMOAMT
+22 SET $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)=""
+23 SET $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,3)=""
+24 SET ABMOFLG=1
End DoDot:2
QUIT
+25 IF $GET(ABMOFLG)=1
KILL ABMOFLG
QUIT
+26 KILL DIR,Y,X
+27 SET DIR(0)="PO^90052.01^W "" ""_$P($G(^BAR(90052.01,+Y,0)),U)"
+28 SET DIR("S")="I "",3,4,13,14,15,16,20,21,22,""[("",""_Y_"","")"
+29 SET DIR("A")="ADJUSTMENT CATEGORY"
+30 IF $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)'=""
SET DIR("B")=$PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)
+31 DO ^DIR
KILL DIR
+32 IF Y<0
IF X="@"
SET $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)=""
+33 ;
+34 IF Y>0
Begin DoDot:2
+35 SET ABMADJC=$PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)
+36 IF ABMADJC=3
SET ABMPM("WO")=+ABMPM("WO")-ABMOAMT
+37 IF ABMADJC=4
SET ABMPM("NONC")=+ABMPM("NONC")-ABMOAMT
+38 IF ABMADJC=13
SET ABMPM("DED")=+ABMPM("DED")-ABMOAMT
+39 IF ABMADJC=14
SET ABMPM("COI")=+ABMPM("COI")-ABMOAMT
+40 IF ABMADJC=15
SET ABMPM("PENS")=+ABMPM("PENS")-ABMOAMT
+41 IF ABMADJC=16
SET ABMPM("GRP")=+ABMPM("GRP")-ABMOAMT
+42 IF ABMADJC=19
SET ABMPM("REF")=+ABMPM("REF")-ABMOAMT
+43 IF ABMADJC=20
SET ABMPM("PCR")=+ABMPM("PCR")-ABMOAMT
+44 ;
+45 IF +Y=3
SET ABMPM("WO")=+ABMPM("WO")+ABMAMT
+46 IF +Y=4
SET ABMPM("NONC")=+ABMPM("NONC")+ABMAMT
+47 IF +Y=13
SET ABMPM("DED")=+ABMPM("DED")+ABMAMT
+48 IF +Y=14
SET ABMPM("COI")=+ABMPM("COI")+ABMAMT
+49 IF +Y=15
SET ABMPM("PENS")=+ABMPM("PENS")+ABMAMT
+50 IF +Y=16
SET ABMPM("GRP")=+ABMPM("GRP")+ABMAMT
+51 IF +Y=19
SET ABMPM("REF")=+ABMPM("REF")+ABMAMT
+52 IF +Y=20
SET ABMPM("PCR")=+ABMPM("PCR")+ABMAMT
+53 ;
+54 SET $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)=+Y
SET ABMADJC=+Y
End DoDot:2
+55 KILL DIR,Y,X
+56 SET DIR(0)="PO^90052.02^W "" ""_$P($G(^BARTBL(+Y,0)),U)"
+57 SET DIR("S")="I $P(^(0),U,2)=ABMADJC"
+58 SET DIR("A")="ADJUSTMENT REASON"
+59 IF $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,3)'=""
SET DIR("B")=$PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,3)
+60 DO ^DIR
KILL DIR
+61 IF Y<0
IF X="@"
SET $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,3)=""
+62 IF Y>0
SET $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,3)=+Y
+63 KILL DIR,Y,X
+64 SET DIR(0)="PO^90056.06"
+65 SET DIR("A")="STANDARD REASON"
+66 IF $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,4)'=""
SET DIR("B")=$PIECE(^BARADJ($PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,4),0),U)
+67 DO ^DIR
KILL DIR
+68 IF Y<0
IF X="@"
SET $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,4)=""
+69 IF Y>0
SET $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,4)=+Y
+70 ;delete any info for billable
SET $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,5)=""
+71 IF $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)'=13&($PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)'=14)&($PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)'=21)&($PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)'=22)
Begin DoDot:2
+72 KILL DIR,X,Y
+73 SET DIR(0)="Y"
+74 SET DIR("B")="Y"
+75 SET DIR("A")="Do you want to include in secondary balance"
+76 DO ^DIR
KILL DIR
+77 IF Y>0
SET $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,5)="Y"
End DoDot:2
+78 IF ($PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)=21)!($PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)=22)
SET $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,5)="N"
End DoDot:1
+79 IF $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)=13!($PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)=14)
SET $PIECE(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,5)="Y"
+80 QUIT
XIT ;EP
+1 ;this files changes into pymt multiple
IF +$GET(ABMSFLG)=0
DO EN^ABMPPFLR
+2 SET ABMP("C0")=$GET(ABMDCLM(DUZ(2),ABMP("CDFN"),0))
+3 KILL ABM,ABMV,ABME,ABMPL,ABMPRIS
+4 KILL ABMSTAT,ABMPR,ABMIIEN,ABMINS,ABMLN,ABMCAT,ABMTTYP,ABMCAT
+5 KILL ABMLAMT,ABMLNSV,ABMOPDT,DR,DIC,DIE
+6 KILL ABMPREC
+7 SET ABMP("SCRN")=0
+8 SET (ABMP("TOT"),ABMS("TOT"))=ABMPM("TOT")
+9 SET ABMP("EXP",ABMP("EXP"))=ABMPM("TOT")
+10 QUIT
