- ABMPPAD2 ; IHS/SD/SDR - Prior Payments/Adjustments page (CE);
- ;;2.6;IHS 3P BILLING SYSTEM;**11**;NOV 12, 2009;Build 133
- ;
- DISP ;EP
- K ABMSFLG,ABMMFLG,ABMEFLG,ABMRSTR
- D SETVAR^ABMPPAD1
- S ABMDASH="",$P(ABMDASH,"-",80)=""
- S ABMZ("TITL")="PRIOR PAYMENTS/ADJUSTMENTS"
- S ABMP("SCRN")="A"
- S ABMZ("PG")="A"
- I '$D(ABMP("DDL")) D SUM^ABMDE1 I 1
- E S ABMC("CONT")="" D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT
- ;
- S ABMINS=0
- F S ABMINS=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINS)) Q:+ABMINS=0 D
- .S ABMIIEN=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINS,0)),U)
- .S ABMPRI=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINS,0)),U,2)
- .S ABMSTAT=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINS,0)),U,3)
- .Q:ABMSTAT'="I"&(ABMSTAT'="C")
- .S ABMLST("PRIO",ABMPRI,ABMIIEN)=ABMINS_"^"_ABMSTAT
- ;
- S ABMP("CBAMT")=0
- S ABMIPRI=0
- F S ABMIPRI=$O(ABMLST("PRIO",ABMIPRI)) Q:+ABMIPRI=0 D
- .S ABMIIEN=0
- .F S ABMIIEN=$O(ABMLST("PRIO",ABMIPRI,ABMIIEN)) Q:+ABMIIEN=0 D
- ..S ABMCAT=""
- ..F S ABMCAT=$O(ABMLST("TRANS",ABMIIEN,ABMCAT)) Q:ABMCAT="" D
- ...S ABMLN=0
- ...F S ABMLN=$O(ABMLST("TRANS",ABMIIEN,ABMCAT,ABMLN)) Q:+ABMLN=0 D
- ....S ABMTREC=$G(ABMLST("TRANS",ABMIIEN,ABMCAT,ABMLN))
- ....I $P(ABMTREC,U,5)="Y" S ABMP("CBAMT")=ABMP("CBAMT")+($FN($P(ABMTREC,U),"-"))
- ....I ABMCAT="P" S ABMPM("PD")=+$G(ABMPM("PD"))+($P(ABMTREC,U))
- ....I ABMCAT="A" D
- .....S ABMATYP=$P(ABMTREC,U,2)
- .....S ABMAAMT=$P(ABMTREC,U)
- .....S:ABMATYP=3 ABMPM("WO")=+$G(ABMPM("WO"))+ABMAAMT
- .....S:ABMATYP=4 ABMPM("NONC")=+$G(ABMPM("NONC"))+ABMAAMT
- .....S:ABMATYP=13 ABMPM("DED")=+$G(ABMPM("DED"))+ABMAAMT
- .....S:ABMATYP=14 ABMPM("COI")=+$G(ABMPM("COI"))+ABMAAMT
- .....S:ABMATYP=15 ABMPM("PENS")=+$G(ABMPM("PENS"))+ABMAAMT
- .....S:ABMATYP=16 ABMPM("GRP")=+$G(ABMPM("GRP"))+ABMAAMT
- .....S:ABMATYP=19 ABMPM("REF")=+$G(ABMPM("REF"))+ABMAAMT
- .....S:ABMATYP=20 ABMPM("PCR")=+$G(ABMPM("PCR"))+ABMAAMT
- ;
- W !,"Payment Amount....: " S ABMNFLG=1 W $$DOLAMT(ABMPM("PD")) K ABMNFLG
- W ?40,"Deductible Amount.: ",$$DOLAMT(ABMPM("DED"))
- W !,"Payment Credits...: ",$$DOLAMT(ABMPM("PCR"))
- W ?40,"Co-pay/ins Amount.: ",$$DOLAMT(ABMPM("COI"))
- W !?40,"Write Off.........: ",$$DOLAMT(ABMPM("WO"))
- W !,"Refund............: ",$$DOLAMT(ABMPM("REF"))
- W ?40,"Non-Covered Amount: ",$$DOLAMT(ABMPM("NONC"))
- W !?40,"Penalty Amount....: ",$$DOLAMT(ABMPM("PENS"))
- W !?40,"Grouper Allowance.: ",$$DOLAMT(ABMPM("GRP"))
- S ABMRVFLG=1 ;abm*2.6*11 HEAT81390
- ;
- S ABMPRI=0
- F S ABMPRI=$O(ABMLST("PRIO",ABMPRI)) Q:+ABMPRI=0 D
- .S ABMIIEN=0
- .S ABMPRIS=ABMPRI
- .F S ABMIIEN=$O(ABMLST("PRIO",ABMPRI,ABMIIEN)) Q:+ABMIIEN=0 D
- ..S ABMSTAT=$P(ABMLST("PRIO",ABMPRI,ABMIIEN),U,2)
- ..S ABMINS=$P(ABMLST("PRIO",ABMPRI,ABMIIEN),U)
- ..S ABMSTAT=$S(ABMSTAT="F":"FLAGGED",ABMSTAT="I":"ACTIVE",ABMSTAT="P":"PENDING",ABMSTAT="U":"UNBILLABLE",ABMSTAT="C":"COMPLETED",ABMSTAT="B":"BILLED",ABMSTAT="L":"PARTIAL",1:"")
- ..W !!,"["_ABMPRI_"] INSURER: ",$E($P($G(^AUTNINS(ABMIIEN,0)),U),1,27)
- ..W ?40,"PRIORITY ORDER: ",ABMPRI
- ..W ?62,"STATUS: "
- ..W $S(ABMSTAT="COMPLETED":$$EN^ABMVDF("RVN"),1:""),ABMSTAT,$S(ABMSTAT="COMPLETED":$$EN^ABMVDF("RVF"),1:"")
- ..S ABMCOV=0
- ..F S ABMCOV=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINS,11,ABMCOV)) Q:+ABMCOV=0 D
- ...I $P($G(^AUTNINS(ABMIIEN,0)),U)["MEDICARE" D
- ....W !?14,"COVERAGE TYPE: ",$P($G(^AUTTPIC(ABMCOV,0)),U)
- ....S ABMCOV=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINS,11,ABMCOV))
- ....I +ABMCOV'=0 W ", ",$P($G(^AUTTPIC(ABMCOV,0)),U)
- ...E W !?14,"COVERAGE TYPE: ",$P($G(^AUTTPIC(ABMCOV,0)),U)
- ..S ABMCAT=""
- ..F S ABMCAT=$O(ABMLST("TRANS",ABMIIEN,ABMCAT),-1) Q:ABMCAT="" D
- ...S ABMLN=0
- ...F S ABMLN=$O(ABMLST("TRANS",ABMIIEN,ABMCAT,ABMLN)) Q:+ABMLN=0 D
- ....Q:+$P(ABMLST("TRANS",ABMIIEN,ABMCAT,ABMLN),U)=0
- ....I +$G(ABMLNSV)<ABMLN S ABMLNSV=ABMLN
- ....S ABMDAMT=$P($G(ABMLST("TRANS",ABMIIEN,ABMCAT,ABMLN)),U)
- ....I ABMCAT="P" S ABMNFLG=1
- ....S ABMDAMT=$$DOLAMT(ABMDAMT)
- ....K ABMNFLG
- ....I ABMCAT="P" W !?6,"PYMT: ",ABMDAMT
- ....E D ADJS
- W !,ABMDASH,!
- I ("^21^22^23^31^32^33^"[("^"_ABMP("EXP")_"^")) D
- .I $G(ABMSFLG)=1 W "ERROR: STANDARD ADJUSTMENT CODE NOT ENTERED FOR ADJUSTMENT",!
- .I $G(ABMMFLG)=1 W "ERROR: STANDARD ADJUSTMENT REASON DOESN'T MATCH ADJUSTMENT CATEGORY/REASON",!
- .I ABMP("CBAMT")<0 W "ERROR: NEGATIVE BALANCE ON BILL NOT ALLOWED",! S ABMSFLG=1
- .I $G(ABMSFLG)=1!($G(ABMMFLG)=1) W ABMDASH,!
- .I $G(ABMSFLG)=1 W "**Use the EDIT option to populate the Standard Adjustment Reason Code**",!
- E K ABMSFLG,ABMMFLG ;remove flag for other checks of this error
- ;
- S ABMP("OPT")="AERSQ"
- S ABMP("DFLT")="Q"
- D SEL
- I "AERS"'[$E(Y) D XIT^ABMPPADJ Q
- I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) D XIT^ABMPPADJ Q
- S ABM("DO")=$S($E(Y)="A":"ADD^ABMPPADJ",$E(Y)="E":"EDIT^ABMPPADJ",$E(Y)="R":"RESTR^ABMPPADJ",$E(Y)="S":"EN^ABMPPFLR",1:"XIT^ABMPPADJ") D @ABM("DO")
- G DISP
- Q
- ADJS ;EP
- W !?7,"ADJ: ",ABMDAMT
- S ABMPREC=$G(ABMLST("TRANS",ABMIIEN,ABMCAT,ABMLN))
- ;I $P(ABMPREC,U,5)="Y" W ?24,"<B>"
- ;I $P(ABMPREC,U,5)="N" W ?24,"<N>"
- I $P(ABMPREC,U,2)'="" W ?28,"[",$P(ABMPREC,U,2),"] ",$E($P($G(^BAR(90052.01,$P(ABMPREC,U,2),0)),U),1,18)
- I $P(ABMPREC,U,3)'="" W ?47,"[",$P(ABMPREC,U,3),"] ",$E($P($G(^BARTBL($P(ABMPREC,U,3),0)),U),1,18)
- I $P($G(ABMPREC),U,4)'="" D
- .W ?75,"["_$P(^BARADJ($P($G(ABMPREC),U,4),0),U)_"]"
- .I $P(^BARADJ($P(ABMPREC,U,4),0),U,3)'=$P(ABMPREC,U,2) S ABMMFLG=1
- .I $P(^BARADJ($P(ABMPREC,U,4),0),U,4)'=$P(ABMPREC,U,3) S ABMMFLG=1
- I $P($G(ABMPREC),U,4)="",($P(ABMPREC,U)'=0) S ABMSFLG=1
- Q
- DOLAMT(AMT) ;
- Q $S(($E(AMT,1)="-"!($G(ABMNFLG)=1))&(AMT'=0):"("_$J($S($E(AMT)="-":$E(AMT,2,$L(AMT)),1:AMT),10,2)_")",1:$J(+$G(AMT),11,2))
- ;
- SEL ;EP for Page Commands, Desired Action Controller
- I $D(ABMP("DDL")),$D(ABMP("QUIT")) S Y="Q" G XIT
- S:'$D(ABMP("DFLT")) ABMP("DFLT")=""
- K %P,DIR S DIR(0)="F^1:9"
- S (DIR("B"),ABMO("DFLT"))=$S(ABMP("DFLT")]"":ABMP("DFLT"),ABMP("OPT")'["N":"B",1:"N")
- S DIR("A")="Desired ACTION ("
- S DIR("?",1)=" Choose from one of the following actions:"
- S DIR("?",2)=" "
- F ABMO("CTR")=3:1 S ABMO("TXT")=$E(ABMP("OPT"),ABMO("CTR")-2) Q:ABMO("TXT")="" D
- .I $D(ABMP("VIEWMODE")),"NVBJQ"'[ABMO("TXT") Q
- .S DIR("?",ABMO("CTR"))=$P($T(@ABMO("TXT")),";;",2),DIR("A")=DIR("A")_$P($T(@ABMO("TXT")),";;",3)_"/"
- S DIR("?",ABMO("CTR"))=" "
- S DIR("?")=" Enter First Character of the Desired Action."
- S DIR("A")=$P(DIR("A"),"/",1,$L(DIR("A"),"/")-1)_")"
- D ^DIR K DIR
- G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
- S:X="" Y=ABMO("DFLT")
- S Y=$$UPC^ABMERUTL(Y)
- I $E(X)="?" D ^ABMDEHLP G SEL
- I '+$E(Y),'+$E(Y,2),$E(Y,2)'=0 S Y=$E(Y)
- I $A(Y,1)>96&($A(Y,1)<123) S Y=$C($A(Y,1)-32)_$E(Y,2,99)
- I ABMP("OPT")[$E(Y) K ABMP("DFLT") G XIT
- I +Y,$D(ABMZ("NUM")),Y<(ABMZ("NUM")+1) K ABMP("DFLT") S Y="E"_+Y G XIT
- W *7 G SEL
- ;
- A ;; Add - Add a New Entry;;Add
- E ;; Edit - Edit Information in the Current Screen;;Edit
- R ;; Rstr - Restore transactions from A/R;;Restore
- S ;; Save - Save transactions;;Save
- Q ;; Quit - Stop Editing the Data;;Quit
- ;
- FLDS ;EP for Field Edit Controller
- S ABMO("Y")=+$E(Y,2,3) I ABMO("Y")>0&(ABMO("Y")<(ABMP("FLDS")+1)) S Y=ABMO("Y") G EJ
- W ! S DIR(0)="LO^1:"_ABMP("FLDS"),DIR("A")="Desired FIELDS",DIR("B")="1-"_ABMP("FLDS") D ^DIR K DIR
- G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
- EJ S ABMP("FLDS")=Y
- G XIT
- ;
- XIT K ABMO,ABMP("OPT")
- Q
- ABMPPAD2 ; IHS/SD/SDR - Prior Payments/Adjustments page (CE);
- +1 ;;2.6;IHS 3P BILLING SYSTEM;**11**;NOV 12, 2009;Build 133
- +2 ;
- DISP ;EP
- +1 KILL ABMSFLG,ABMMFLG,ABMEFLG,ABMRSTR
- +2 DO SETVAR^ABMPPAD1
- +3 SET ABMDASH=""
- SET $PIECE(ABMDASH,"-",80)=""
- +4 SET ABMZ("TITL")="PRIOR PAYMENTS/ADJUSTMENTS"
- +5 SET ABMP("SCRN")="A"
- +6 SET ABMZ("PG")="A"
- +7 IF '$DATA(ABMP("DDL"))
- DO SUM^ABMDE1
- IF 1
- +8 IF '$TEST
- SET ABMC("CONT")=""
- DO PAUSE^ABMDE1
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
- GOTO XIT
- +9 ;
- +10 SET ABMINS=0
- +11 FOR
- SET ABMINS=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINS))
- IF +ABMINS=0
- QUIT
- Begin DoDot:1
- +12 SET ABMIIEN=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINS,0)),U)
- +13 SET ABMPRI=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINS,0)),U,2)
- +14 SET ABMSTAT=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINS,0)),U,3)
- +15 IF ABMSTAT'="I"&(ABMSTAT'="C")
- QUIT
- +16 SET ABMLST("PRIO",ABMPRI,ABMIIEN)=ABMINS_"^"_ABMSTAT
- End DoDot:1
- +17 ;
- +18 SET ABMP("CBAMT")=0
- +19 SET ABMIPRI=0
- +20 FOR
- SET ABMIPRI=$ORDER(ABMLST("PRIO",ABMIPRI))
- IF +ABMIPRI=0
- QUIT
- Begin DoDot:1
- +21 SET ABMIIEN=0
- +22 FOR
- SET ABMIIEN=$ORDER(ABMLST("PRIO",ABMIPRI,ABMIIEN))
- IF +ABMIIEN=0
- QUIT
- Begin DoDot:2
- +23 SET ABMCAT=""
- +24 FOR
- SET ABMCAT=$ORDER(ABMLST("TRANS",ABMIIEN,ABMCAT))
- IF ABMCAT=""
- QUIT
- Begin DoDot:3
- +25 SET ABMLN=0
- +26 FOR
- SET ABMLN=$ORDER(ABMLST("TRANS",ABMIIEN,ABMCAT,ABMLN))
- IF +ABMLN=0
- QUIT
- Begin DoDot:4
- +27 SET ABMTREC=$GET(ABMLST("TRANS",ABMIIEN,ABMCAT,ABMLN))
- +28 IF $PIECE(ABMTREC,U,5)="Y"
- SET ABMP("CBAMT")=ABMP("CBAMT")+($FNUMBER($PIECE(ABMTREC,U),"-"))
- +29 IF ABMCAT="P"
- SET ABMPM("PD")=+$GET(ABMPM("PD"))+($PIECE(ABMTREC,U))
- +30 IF ABMCAT="A"
- Begin DoDot:5
- +31 SET ABMATYP=$PIECE(ABMTREC,U,2)
- +32 SET ABMAAMT=$PIECE(ABMTREC,U)
- +33 IF ABMATYP=3
- SET ABMPM("WO")=+$GET(ABMPM("WO"))+ABMAAMT
- +34 IF ABMATYP=4
- SET ABMPM("NONC")=+$GET(ABMPM("NONC"))+ABMAAMT
- +35 IF ABMATYP=13
- SET ABMPM("DED")=+$GET(ABMPM("DED"))+ABMAAMT
- +36 IF ABMATYP=14
- SET ABMPM("COI")=+$GET(ABMPM("COI"))+ABMAAMT
- +37 IF ABMATYP=15
- SET ABMPM("PENS")=+$GET(ABMPM("PENS"))+ABMAAMT
- +38 IF ABMATYP=16
- SET ABMPM("GRP")=+$GET(ABMPM("GRP"))+ABMAAMT
- +39 IF ABMATYP=19
- SET ABMPM("REF")=+$GET(ABMPM("REF"))+ABMAAMT
- +40 IF ABMATYP=20
- SET ABMPM("PCR")=+$GET(ABMPM("PCR"))+ABMAAMT
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +41 ;
- +42 WRITE !,"Payment Amount....: "
- SET ABMNFLG=1
- WRITE $$DOLAMT(ABMPM("PD"))
- KILL ABMNFLG
- +43 WRITE ?40,"Deductible Amount.: ",$$DOLAMT(ABMPM("DED"))
- +44 WRITE !,"Payment Credits...: ",$$DOLAMT(ABMPM("PCR"))
- +45 WRITE ?40,"Co-pay/ins Amount.: ",$$DOLAMT(ABMPM("COI"))
- +46 WRITE !?40,"Write Off.........: ",$$DOLAMT(ABMPM("WO"))
- +47 WRITE !,"Refund............: ",$$DOLAMT(ABMPM("REF"))
- +48 WRITE ?40,"Non-Covered Amount: ",$$DOLAMT(ABMPM("NONC"))
- +49 WRITE !?40,"Penalty Amount....: ",$$DOLAMT(ABMPM("PENS"))
- +50 WRITE !?40,"Grouper Allowance.: ",$$DOLAMT(ABMPM("GRP"))
- +51 ;abm*2.6*11 HEAT81390
- SET ABMRVFLG=1
- +52 ;
- +53 SET ABMPRI=0
- +54 FOR
- SET ABMPRI=$ORDER(ABMLST("PRIO",ABMPRI))
- IF +ABMPRI=0
- QUIT
- Begin DoDot:1
- +55 SET ABMIIEN=0
- +56 SET ABMPRIS=ABMPRI
- +57 FOR
- SET ABMIIEN=$ORDER(ABMLST("PRIO",ABMPRI,ABMIIEN))
- IF +ABMIIEN=0
- QUIT
- Begin DoDot:2
- +58 SET ABMSTAT=$PIECE(ABMLST("PRIO",ABMPRI,ABMIIEN),U,2)
- +59 SET ABMINS=$PIECE(ABMLST("PRIO",ABMPRI,ABMIIEN),U)
- +60 SET ABMSTAT=$SELECT(ABMSTAT="F":"FLAGGED",ABMSTAT="I":"ACTIVE",ABMSTAT="P":"PENDING",ABMSTAT="U":"UNBILLABLE",ABMSTAT="C":"COMPLETED",ABMSTAT="B":"BILLED",ABMSTAT="L":"PARTIAL",1:"")
- +61 WRITE !!,"["_ABMPRI_"] INSURER: ",$EXTRACT($PIECE($GET(^AUTNINS(ABMIIEN,0)),U),1,27)
- +62 WRITE ?40,"PRIORITY ORDER: ",ABMPRI
- +63 WRITE ?62,"STATUS: "
- +64 WRITE $SELECT(ABMSTAT="COMPLETED":$$EN^ABMVDF("RVN"),1:""),ABMSTAT,$SELECT(ABMSTAT="COMPLETED":$$EN^ABMVDF("RVF"),1:"")
- +65 SET ABMCOV=0
- +66 FOR
- SET ABMCOV=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINS,11,ABMCOV))
- IF +ABMCOV=0
- QUIT
- Begin DoDot:3
- +67 IF $PIECE($GET(^AUTNINS(ABMIIEN,0)),U)["MEDICARE"
- Begin DoDot:4
- +68 WRITE !?14,"COVERAGE TYPE: ",$PIECE($GET(^AUTTPIC(ABMCOV,0)),U)
- +69 SET ABMCOV=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINS,11,ABMCOV))
- +70 IF +ABMCOV'=0
- WRITE ", ",$PIECE($GET(^AUTTPIC(ABMCOV,0)),U)
- End DoDot:4
- +71 IF '$TEST
- WRITE !?14,"COVERAGE TYPE: ",$PIECE($GET(^AUTTPIC(ABMCOV,0)),U)
- End DoDot:3
- +72 SET ABMCAT=""
- +73 FOR
- SET ABMCAT=$ORDER(ABMLST("TRANS",ABMIIEN,ABMCAT),-1)
- IF ABMCAT=""
- QUIT
- Begin DoDot:3
- +74 SET ABMLN=0
- +75 FOR
- SET ABMLN=$ORDER(ABMLST("TRANS",ABMIIEN,ABMCAT,ABMLN))
- IF +ABMLN=0
- QUIT
- Begin DoDot:4
- +76 IF +$PIECE(ABMLST("TRANS",ABMIIEN,ABMCAT,ABMLN),U)=0
- QUIT
- +77 IF +$GET(ABMLNSV)<ABMLN
- SET ABMLNSV=ABMLN
- +78 SET ABMDAMT=$PIECE($GET(ABMLST("TRANS",ABMIIEN,ABMCAT,ABMLN)),U)
- +79 IF ABMCAT="P"
- SET ABMNFLG=1
- +80 SET ABMDAMT=$$DOLAMT(ABMDAMT)
- +81 KILL ABMNFLG
- +82 IF ABMCAT="P"
- WRITE !?6,"PYMT: ",ABMDAMT
- +83 IF '$TEST
- DO ADJS
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +84 WRITE !,ABMDASH,!
- +85 IF ("^21^22^23^31^32^33^"[("^"_ABMP("EXP")_"^"))
- Begin DoDot:1
- +86 IF $GET(ABMSFLG)=1
- WRITE "ERROR: STANDARD ADJUSTMENT CODE NOT ENTERED FOR ADJUSTMENT",!
- +87 IF $GET(ABMMFLG)=1
- WRITE "ERROR: STANDARD ADJUSTMENT REASON DOESN'T MATCH ADJUSTMENT CATEGORY/REASON",!
- +88 IF ABMP("CBAMT")<0
- WRITE "ERROR: NEGATIVE BALANCE ON BILL NOT ALLOWED",!
- SET ABMSFLG=1
- +89 IF $GET(ABMSFLG)=1!($GET(ABMMFLG)=1)
- WRITE ABMDASH,!
- +90 IF $GET(ABMSFLG)=1
- WRITE "**Use the EDIT option to populate the Standard Adjustment Reason Code**",!
- End DoDot:1
- +91 ;remove flag for other checks of this error
- IF '$TEST
- KILL ABMSFLG,ABMMFLG
- +92 ;
- +93 SET ABMP("OPT")="AERSQ"
- +94 SET ABMP("DFLT")="Q"
- +95 DO SEL
- +96 IF "AERS"'[$EXTRACT(Y)
- DO XIT^ABMPPADJ
- QUIT
- +97 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- DO XIT^ABMPPADJ
- QUIT
- +98 SET ABM("DO")=$SELECT($EXTRACT(Y)="A":"ADD^ABMPPADJ",$EXTRACT(Y)="E":"EDIT^ABMPPADJ",$EXTRACT(Y)="R":"RESTR^ABMPPADJ",$EXTRACT(Y)="S":"EN^ABMPPFLR",1:"XIT^ABMPPADJ")
- DO @ABM("DO")
- +99 GOTO DISP
- +100 QUIT
- ADJS ;EP
- +1 WRITE !?7,"ADJ: ",ABMDAMT
- +2 SET ABMPREC=$GET(ABMLST("TRANS",ABMIIEN,ABMCAT,ABMLN))
- +3 ;I $P(ABMPREC,U,5)="Y" W ?24,"<B>"
- +4 ;I $P(ABMPREC,U,5)="N" W ?24,"<N>"
- +5 IF $PIECE(ABMPREC,U,2)'=""
- WRITE ?28,"[",$PIECE(ABMPREC,U,2),"] ",$EXTRACT($PIECE($GET(^BAR(90052.01,$PIECE(ABMPREC,U,2),0)),U),1,18)
- +6 IF $PIECE(ABMPREC,U,3)'=""
- WRITE ?47,"[",$PIECE(ABMPREC,U,3),"] ",$EXTRACT($PIECE($GET(^BARTBL($PIECE(ABMPREC,U,3),0)),U),1,18)
- +7 IF $PIECE($GET(ABMPREC),U,4)'=""
- Begin DoDot:1
- +8 WRITE ?75,"["_$PIECE(^BARADJ($PIECE($GET(ABMPREC),U,4),0),U)_"]"
- +9 IF $PIECE(^BARADJ($PIECE(ABMPREC,U,4),0),U,3)'=$PIECE(ABMPREC,U,2)
- SET ABMMFLG=1
- +10 IF $PIECE(^BARADJ($PIECE(ABMPREC,U,4),0),U,4)'=$PIECE(ABMPREC,U,3)
- SET ABMMFLG=1
- End DoDot:1
- +11 IF $PIECE($GET(ABMPREC),U,4)=""
- IF ($PIECE(ABMPREC,U)'=0)
- SET ABMSFLG=1
- +12 QUIT
- DOLAMT(AMT) ;
- +1 QUIT $SELECT(($EXTRACT(AMT,1)="-"!($GET(ABMNFLG)=1))&(AMT'=0):"("_$JUSTIFY($SELECT($EXTRACT(AMT)="-":$EXTRACT(AMT,2,$LENGTH(AMT)),1:AMT),10,2)_")",1:$JUSTIFY(+$GET(AMT),11,2))
- +2 ;
- SEL ;EP for Page Commands, Desired Action Controller
- +1 IF $DATA(ABMP("DDL"))
- IF $DATA(ABMP("QUIT"))
- SET Y="Q"
- GOTO XIT
- +2 IF '$DATA(ABMP("DFLT"))
- SET ABMP("DFLT")=""
- +3 KILL %P,DIR
- SET DIR(0)="F^1:9"
- +4 SET (DIR("B"),ABMO("DFLT"))=$SELECT(ABMP("DFLT")]"":ABMP("DFLT"),ABMP("OPT")'["N":"B",1:"N")
- +5 SET DIR("A")="Desired ACTION ("
- +6 SET DIR("?",1)=" Choose from one of the following actions:"
- +7 SET DIR("?",2)=" "
- +8 FOR ABMO("CTR")=3:1
- SET ABMO("TXT")=$EXTRACT(ABMP("OPT"),ABMO("CTR")-2)
- IF ABMO("TXT")=""
- QUIT
- Begin DoDot:1
- +9 IF $DATA(ABMP("VIEWMODE"))
- IF "NVBJQ"'[ABMO("TXT")
- QUIT
- +10 SET DIR("?",ABMO("CTR"))=$PIECE($TEXT(@ABMO("TXT")),";;",2)
- SET DIR("A")=DIR("A")_$PIECE($TEXT(@ABMO("TXT")),";;",3)_"/"
- End DoDot:1
- +11 SET DIR("?",ABMO("CTR"))=" "
- +12 SET DIR("?")=" Enter First Character of the Desired Action."
- +13 SET DIR("A")=$PIECE(DIR("A"),"/",1,$LENGTH(DIR("A"),"/")-1)_")"
- +14 DO ^DIR
- KILL DIR
- +15 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- GOTO XIT
- +16 IF X=""
- SET Y=ABMO("DFLT")
- +17 SET Y=$$UPC^ABMERUTL(Y)
- +18 IF $EXTRACT(X)="?"
- DO ^ABMDEHLP
- GOTO SEL
- +19 IF '+$EXTRACT(Y)
- IF '+$EXTRACT(Y,2)
- IF $EXTRACT(Y,2)'=0
- SET Y=$EXTRACT(Y)
- +20 IF $ASCII(Y,1)>96&($ASCII(Y,1)<123)
- SET Y=$CHAR($ASCII(Y,1)-32)_$EXTRACT(Y,2,99)
- +21 IF ABMP("OPT")[$EXTRACT(Y)
- KILL ABMP("DFLT")
- GOTO XIT
- +22 IF +Y
- IF $DATA(ABMZ("NUM"))
- IF Y<(ABMZ("NUM")+1)
- KILL ABMP("DFLT")
- SET Y="E"_+Y
- GOTO XIT
- +23 WRITE *7
- GOTO SEL
- +24 ;
- A ;; Add - Add a New Entry;;Add
- E ;; Edit - Edit Information in the Current Screen;;Edit
- R ;; Rstr - Restore transactions from A/R;;Restore
- S ;; Save - Save transactions;;Save
- Q ;; Quit - Stop Editing the Data;;Quit
- +1 ;
- FLDS ;EP for Field Edit Controller
- +1 SET ABMO("Y")=+$EXTRACT(Y,2,3)
- IF ABMO("Y")>0&(ABMO("Y")<(ABMP("FLDS")+1))
- SET Y=ABMO("Y")
- GOTO EJ
- +2 WRITE !
- SET DIR(0)="LO^1:"_ABMP("FLDS")
- SET DIR("A")="Desired FIELDS"
- SET DIR("B")="1-"_ABMP("FLDS")
- DO ^DIR
- KILL DIR
- +3 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- GOTO XIT
- EJ SET ABMP("FLDS")=Y
- +1 GOTO XIT
- +2 ;
- XIT KILL ABMO,ABMP("OPT")
- +1 QUIT
