Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMPPAD1

ABMPPAD1.m

Go to the documentation of this file. 
  1. ABMPPAD1 ; IHS/SD/SDR - Prior Payments/Adjustments page (CE); 
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**6,8,21**;NOV 12, 2009;Build 379
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p12 - IM25430
  1.  ;   Made correction for <SUBSCR>EDIT2+3^ABMPPAD1
  1.  ;
  1.  ;IHS/SD/SDR - v2.5 p13 - NO IM
  1.  ;IHS/SD/SDR - abm*2.6*6 - 5010 - added export mode 32
  1.  ;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.
  1.  ;
  1.  Q
  1. 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
  1.  ;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
  1.  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
  1.  S ABMCHK=0
  1.  S ABMEXPM=0
  1.  K ABMEXPMS,ABMSFLG,ABMP("OBAMT")
  1.  F  S ABMEXPM=$O(ABMP("EXP",ABMEXPM)) Q:+ABMEXPM=0  D
  1.  .I $G(ABMEXPMS)="" S ABMEXPMS=ABMEXPM
  1.  .I $G(ABMEXPMS)'="",(ABMEXPMS'=ABMEXPM) S ABMCHK=1
  1.  S ABM("CLM")=ABMP("CDFN")
  1.  S ABM("A")="B"
  1.  F  S ABM("A")=$O(^ABMDBILL(DUZ(2),"AS",ABM("CLM"),ABM("A"))) Q:ABM("A")=""!(ABM("A")'="C")  D
  1.  .F ABM=0:0 S ABM=$O(^ABMDBILL(DUZ(2),"AS",ABM("CLM"),ABM("A"),ABM)) Q:'ABM  D
  1.  ..Q:$P($G(^ABMDBILL(DUZ(2),ABM,0)),U,5)'=ABMP("PDFN")
  1.  ..S:(+$G(ABMP("OBAMT"))=0) ABMP("OBAMT")=$P($G(^ABMDBILL(DUZ(2),ABM,2)),U)
  1.  I +$G(ABMP("OBAMT"))=0 S ABMCHK=1
  1.  Q
  1. SETVAR ;EP
  1.  S (ABMPM("PD"),ABMPM("DED"),ABMPM("TOT"))=0
  1.  S (ABMPM("COI"),ABMPM("WO"),ABMPM("NONC"))=0
  1.  S (ABMPM("PENS"),ABMPM("GRP"),ABMPM("REF"))=0
  1.  S ABMPM("PCR")=0
  1.  Q
  1. ADD ;EP
  1.  W !!
  1.  S DIR(0)="NO^1:"_ABMPRIS
  1.  S DIR("A")="Which insurer are you editing"
  1.  D ^DIR K DIR
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S ABMEFLG=1 Q
  1.  I '$D(ABMPL(+Y)) W !,"No insurer at that entry" H 2 S ABMEFLG=1 Q
  1.  S ABMIIEN=$O(ABMPL(+Y,0))
  1.  I $P(ABMPL(+Y,ABMIIEN),U,2)="I" W !,"Cannot add/edit the active insurer!" H 2 S ABMEFLG=1 Q
  1.  W !,"Ok, let's edit ",$P($G(^AUTNINS(ABMIIEN,0)),U),!
  1.  S DIR(0)="SO^P:PAYMENT;A:ADJUSTMENT"
  1.  S DIR("A")="Adding a Payment or Adjustment"
  1.  D ^DIR K DIR
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S ABMEFLG=1 Q
  1.  S ABMCAT=Y
  1.  S (ABMPPIEN,ABMLN,ABMLNSV)=+$G(ABMLNSV)+1
  1.  S ABMPP(ABMIIEN,ABMCAT,ABMLN)=""
  1.  Q
  1. EDIT ;EP
  1.  W !!
  1.  K ABMEFLG
  1.  S DIR(0)="NO^1:"_ABMPRIS
  1.  S DIR("A")="Which insurer are you editing"
  1.  D ^DIR K DIR
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S ABMEFLG=1 Q
  1.  I '$D(ABMPL(+Y)) W !,"No insurer at that entry" H 2 S ABMEFLG=1 Q
  1.  S ABMIIEN=$O(ABMPL(+Y,0))
  1.  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
  1.  W !,"Ok, let's edit ",$P($G(^AUTNINS(ABMIIEN,0)),U),!
  1.  ;start new abm*2.6*6 5010
  1.  D ^XBFMK
  1.  ;start new abm*2.6*21 IHS/SD/SDR HEAT176726
  1.  I +$O(ABMILST(ABMIIEN,0))=0 D
  1.  .F  S ABMBSTA=$O(^ABMDBILL(DUZ(2),"AS",ABMP("CDFN"),ABMBSTA)) Q:ABMBSTA=""  D
  1.  ..Q:ABMBSTA="X"
  1.  ..S ABMBFIEN=0
  1.  ..F  S ABMBFIEN=$O(^ABMDBILL(DUZ(2),"AS",ABMP("CDFN"),ABMBSTA,ABMBFIEN)) Q:+ABMBFIEN=0  D
  1.  ...S ABMBNUM=$P($G(^ABMDBILL(DUZ(2),ABMBFIEN,0)),U)
  1.  ....S ABMLN=+$G(ABMLN)+1
  1.  ....S ABMBINS=$P($G(^ABMDBILL(DUZ(2),ABMBFIEN,0)),U,8)
  1.  ....S ABMILST(ABMBINS,ABMBFIEN)=""
  1.  ;end new abm*2.6*21 IHS/SD/SDR HEAT176726
  1.  S DA(1)=$O(ABMILST(ABMIIEN,0))
  1.  S DIE="^ABMDBILL(DUZ(2),"_DA(1)_",13,"
  1.  S DA=ABMIIEN
  1.  S DR=".12//"
  1.  D ^DIE
  1.  ;end new code 5010
  1.  S ABMCAT=""
  1.  F  S ABMCAT=$O(ABMPP(ABMIIEN,ABMCAT),-1) Q:ABMCAT=""  D
  1.  .S ABMLN=0
  1.  .F  S ABMLN=$O(ABMPP(ABMIIEN,ABMCAT,ABMLN)) Q:+ABMLN=0  D
  1.  ..I $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U)=0 K ABMPP(ABMIIEN,ABMCAT,ABMLN) Q
  1.  ..W !?2,"["_ABMLN_"] "
  1.  ..I ABMCAT="P" W "PAYMENT    ",$J(ABMPP(ABMIIEN,ABMCAT,ABMLN),10,2)
  1.  ..I ABMCAT="A" D
  1.  ...W "ADJUSTMENT ",$J($P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U),10,2)
  1.  ...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)
  1.  ...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)
  1.  ...I $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,4)'="" W ?75,"[",$P(^BARADJ($P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,4),0),U),"]"
  1.  I +$G(ABMLNSV)=0 W !,"Must use Add because there are no transactions to edit!" H 2 S ABMEFLG=1 Q
  1.  S DIR(0)="NO^1:"_ABMLNSV
  1.  S DIR("A")="Which transaction"
  1.  D ^DIR K DIR,ABMLNPK
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S ABMEFLG=1 Q
  1.  S ABMPPIEN=+Y
  1.  Q:'$D(ABMPP(ABMIIEN,"P",ABMPPIEN))&'$D(ABMPP(ABMIIEN,"A",ABMPPIEN))
  1.  S ABMCAT=""
  1.  K ABMLFLG,ABMDIF
  1.  F  S ABMCAT=$O(ABMPP(ABMIIEN,ABMCAT)) Q:ABMCAT=""  D  Q:($G(ABMLFLG)=1)
  1.  .S ABMLN=0
  1.  .F  S ABMLN=$O(ABMPP(ABMIIEN,ABMCAT,ABMLN)) Q:+ABMLN=0  D  Q:($G(ABMLFLG)=1)
  1.  ..I ABMLN=ABMPPIEN S ABMLFLG=1
  1.  Q
  1. EDIT2 ;EP
  1.  S DIR(0)="NO^-99999.99:99999.99:2"
  1.  S DIR("A")="AMOUNT"
  1.  I $P(ABMPP(ABMIIEN,ABMCAT,ABMPPIEN),U)'=0 S DIR("B")=$P(ABMPP(ABMIIEN,ABMCAT,ABMPPIEN),U)
  1.  D ^DIR K DIR
  1.  S ABMAMT=+Y
  1.  S ABMDIF=$P(ABMPP(ABMIIEN,ABMCAT,ABMPPIEN),U)-ABMAMT
  1.  S ABMOAMT=$P(ABMPP(ABMIIEN,ABMCAT,ABMPPIEN),U)
  1.  S $P(ABMPP(ABMIIEN,ABMCAT,ABMPPIEN),U)=+Y
  1.  I ABMCAT="P" D
  1.  .S ABMPM("PD")=+$G(ABMPM("PD"))-(ABMDIF)
  1.  I ABMCAT="A" D
  1.  .I ABMAMT=0 D  Q
  1.  ..S ABMADJC=$P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)
  1.  ..I ABMADJC=3 S ABMPM("WO")=+ABMPM("WO")-ABMOAMT
  1.  ..I ABMADJC=4 S ABMPM("NONC")=+ABMPM("NONC")-ABMOAMT
  1.  ..I ABMADJC=13 S ABMPM("DED")=+ABMPM("DED")-ABMOAMT
  1.  ..I ABMADJC=14 S ABMPM("COI")=+ABMPM("COI")-ABMOAMT
  1.  ..I ABMADJC=15 S ABMPM("PENS")=+ABMPM("PENS")-ABMOAMT
  1.  ..I ABMADJC=16 S ABMPM("GRP")=+ABMPM("GRP")-ABMOAMT
  1.  ..I ABMADJC=19 S ABMPM("REF")=+ABMPM("REF")-ABMOAMT
  1.  ..I ABMADJC=20 S ABMPM("PCR")=+ABMPM("PCR")-ABMOAMT
  1.  ..S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)=""
  1.  ..S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,3)=""
  1.  ..S ABMOFLG=1
  1.  .I $G(ABMOFLG)=1 K ABMOFLG Q
  1.  .K DIR,Y,X
  1.  .S DIR(0)="PO^90052.01^W ""  ""_$P($G(^BAR(90052.01,+Y,0)),U)"
  1.  .S DIR("S")="I "",3,4,13,14,15,16,20,21,22,""[("",""_Y_"","")"
  1.  .S DIR("A")="ADJUSTMENT CATEGORY"
  1.  .I $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)'="" S DIR("B")=$P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)
  1.  .D ^DIR K DIR
  1.  .I Y<0,X="@" S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)=""
  1.  .;
  1.  .I Y>0 D
  1.  ..S ABMADJC=$P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)
  1.  ..I ABMADJC=3 S ABMPM("WO")=+ABMPM("WO")-ABMOAMT
  1.  ..I ABMADJC=4 S ABMPM("NONC")=+ABMPM("NONC")-ABMOAMT
  1.  ..I ABMADJC=13 S ABMPM("DED")=+ABMPM("DED")-ABMOAMT
  1.  ..I ABMADJC=14 S ABMPM("COI")=+ABMPM("COI")-ABMOAMT
  1.  ..I ABMADJC=15 S ABMPM("PENS")=+ABMPM("PENS")-ABMOAMT
  1.  ..I ABMADJC=16 S ABMPM("GRP")=+ABMPM("GRP")-ABMOAMT
  1.  ..I ABMADJC=19 S ABMPM("REF")=+ABMPM("REF")-ABMOAMT
  1.  ..I ABMADJC=20 S ABMPM("PCR")=+ABMPM("PCR")-ABMOAMT
  1.  ..;
  1.  ..I +Y=3 S ABMPM("WO")=+ABMPM("WO")+ABMAMT
  1.  ..I +Y=4 S ABMPM("NONC")=+ABMPM("NONC")+ABMAMT
  1.  ..I +Y=13 S ABMPM("DED")=+ABMPM("DED")+ABMAMT
  1.  ..I +Y=14 S ABMPM("COI")=+ABMPM("COI")+ABMAMT
  1.  ..I +Y=15 S ABMPM("PENS")=+ABMPM("PENS")+ABMAMT
  1.  ..I +Y=16 S ABMPM("GRP")=+ABMPM("GRP")+ABMAMT
  1.  ..I +Y=19 S ABMPM("REF")=+ABMPM("REF")+ABMAMT
  1.  ..I +Y=20 S ABMPM("PCR")=+ABMPM("PCR")+ABMAMT
  1.  ..;
  1.  ..S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,2)=+Y,ABMADJC=+Y
  1.  .K DIR,Y,X
  1.  .S DIR(0)="PO^90052.02^W ""  ""_$P($G(^BARTBL(+Y,0)),U)"
  1.  .S DIR("S")="I $P(^(0),U,2)=ABMADJC"
  1.  .S DIR("A")="ADJUSTMENT REASON"
  1.  .I $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,3)'="" S DIR("B")=$P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,3)
  1.  .D ^DIR K DIR
  1.  .I Y<0,X="@" S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,3)=""
  1.  .I Y>0 S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,3)=+Y
  1.  .K DIR,Y,X
  1.  .S DIR(0)="PO^90056.06"
  1.  .S DIR("A")="STANDARD REASON"
  1.  .I $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,4)'="" S DIR("B")=$P(^BARADJ($P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,4),0),U)
  1.  .D ^DIR K DIR
  1.  .I Y<0,X="@" S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,4)=""
  1.  .I Y>0 S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,4)=+Y
  1.  .S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,5)=""  ;delete any info for billable
  1.  .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
  1.  ..K DIR,X,Y
  1.  ..S DIR(0)="Y"
  1.  ..S DIR("B")="Y"
  1.  ..S DIR("A")="Do you want to include in secondary balance"
  1.  ..D ^DIR K DIR
  1.  ..I Y>0 S $P(ABMPP(ABMIIEN,ABMCAT,ABMLN),U,5)="Y"
  1.  .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"
  1.  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"
  1.  Q
  1. XIT ;EP
  1.  I +$G(ABMSFLG)=0 D EN^ABMPPFLR  ;this files changes into pymt multiple
  1.  S ABMP("C0")=$G(ABMDCLM(DUZ(2),ABMP("CDFN"),0))
  1.  K ABM,ABMV,ABME,ABMPL,ABMPRIS
  1.  K ABMSTAT,ABMPR,ABMIIEN,ABMINS,ABMLN,ABMCAT,ABMTTYP,ABMCAT
  1.  K ABMLAMT,ABMLNSV,ABMOPDT,DR,DIC,DIE
  1.  K ABMPREC
  1.  S ABMP("SCRN")=0
  1.  S (ABMP("TOT"),ABMS("TOT"))=ABMPM("TOT")
  1.  S ABMP("EXP",ABMP("EXP"))=ABMPM("TOT")
  1.  Q