ABMUXCLD ; IHS/SD/SDR - 3PB/UFMS populate Exclusion Table
;;2.6;IHS 3P BILLING SYSTEM;**11**;NOV 12, 2009;Build 133
;
; new routine - v2.5 p12 SDD item 4.4
;
EP ; EP
W !!?3,"WARNING: Entries into the following file will prohibit data from being"
W !?12,"sent to UFMS."
W !?12,"Use EXTREME caution when creating entries."
W !!,"The default to your current location."
K DIR
W !!
S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
;location
I +$P($G(^ABMUXCLD(0)),U,3)=0 W !!,"There is currently no data in file.",!,"""^"" to exit without entry.",!
K DIC,DIE,DA,X,Y
S DIC="^ABMUXCLD("
S DIC(0)="AEMQL"
S DIC("A")="Select Location: "
S DIC("B")=DUZ(2)
D ^DIC
Q:+Y<0
Q:$D(DTOUT)!$D(DUOUT)
S ABMLOC=+Y
;
DISP ;display of existing entries in file
W !!,"Existing entries for "_$P($G(^DIC(4,ABMLOC,0)),U)_":"
W !?3,"Eff. Date"
W ?15,"End Date"
W ?28,"Clinic"
W ?55,"Insurer Type",!
F ABMI=1:1:80 W "-"
S ABMEDT=0
I +$O(^ABMUXCLD(ABMLOC,1,ABMEDT))=0 W !?5,"NO ENTRIES EXIST"
F S ABMEDT=$O(^ABMUXCLD(ABMLOC,1,ABMEDT)) Q:+ABMEDT=0 D
.S ABMREC=$G(^ABMUXCLD(ABMLOC,1,ABMEDT,0))
.W !?3,$$SDT^ABMDUTL($P(ABMREC,U))
.W ?15,$$SDT^ABMDUTL($P(ABMREC,U,2))
.W:$P(ABMREC,U,3)'="" ?28,$P($G(^DIC(40.7,$P(ABMREC,U,3),0)),U,2),?31,$E($P($G(^DIC(40.7,$P(ABMREC,U,3),0)),U),1,20)
.I $P(ABMREC,U,4)'="" D
..S ABMTYP=$P(ABMREC,U,4)
..;W ?55,$P($T(@ABMTYP^ABMUCASH),";;",2) ;abm*2.6*11 insurer type
..W ?55,$$INSTYP^ABMUCASH(ABMTYP) ;abm*2.6*11 insurer type
W !
;effective date
K DIC,DIE,DA,X,Y
S DA(1)=ABMLOC
S DIC="^ABMUXCLD(DA(1),1,"
S DIC(0)="AEQLV"
D ^DIC
Q:+Y<0
Q:$D(DTOUT)!$D(DUOUT)
S ABMEFFDT=+Y
;everything else
K DIC,DIE,DA,X,Y
S DA(1)=ABMLOC
S DIE="^ABMUXCLD(DA(1),1,"
S DA=ABMEFFDT
S DR=".03;.04;.02"
D ^DIE
G DISP
Q
ABMUXCLD ; IHS/SD/SDR - 3PB/UFMS populate Exclusion Table
+1 ;;2.6;IHS 3P BILLING SYSTEM;**11**;NOV 12, 2009;Build 133
+2 ;
+3 ; new routine - v2.5 p12 SDD item 4.4
+4 ;
EP ; EP
+1 WRITE !!?3,"WARNING: Entries into the following file will prohibit data from being"
+2 WRITE !?12,"sent to UFMS."
+3 WRITE !?12,"Use EXTREME caution when creating entries."
+4 WRITE !!,"The default to your current location."
+5 KILL DIR
+6 WRITE !!
+7 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
+8 ;location
+9 IF +$PIECE($GET(^ABMUXCLD(0)),U,3)=0
WRITE !!,"There is currently no data in file.",!,"""^"" to exit without entry.",!
+10 KILL DIC,DIE,DA,X,Y
+11 SET DIC="^ABMUXCLD("
+12 SET DIC(0)="AEMQL"
+13 SET DIC("A")="Select Location: "
+14 SET DIC("B")=DUZ(2)
+15 DO ^DIC
+16 IF +Y<0
QUIT
+17 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+18 SET ABMLOC=+Y
+19 ;
DISP ;display of existing entries in file
+1 WRITE !!,"Existing entries for "_$PIECE($GET(^DIC(4,ABMLOC,0)),U)_":"
+2 WRITE !?3,"Eff. Date"
+3 WRITE ?15,"End Date"
+4 WRITE ?28,"Clinic"
+5 WRITE ?55,"Insurer Type",!
+6 FOR ABMI=1:1:80
WRITE "-"
+7 SET ABMEDT=0
+8 IF +$ORDER(^ABMUXCLD(ABMLOC,1,ABMEDT))=0
WRITE !?5,"NO ENTRIES EXIST"
+9 FOR
SET ABMEDT=$ORDER(^ABMUXCLD(ABMLOC,1,ABMEDT))
IF +ABMEDT=0
QUIT
Begin DoDot:1
+10 SET ABMREC=$GET(^ABMUXCLD(ABMLOC,1,ABMEDT,0))
+11 WRITE !?3,$$SDT^ABMDUTL($PIECE(ABMREC,U))
+12 WRITE ?15,$$SDT^ABMDUTL($PIECE(ABMREC,U,2))
+13 IF $PIECE(ABMREC,U,3)'=""
WRITE ?28,$PIECE($GET(^DIC(40.7,$PIECE(ABMREC,U,3),0)),U,2),?31,$EXTRACT($PIECE($GET(^DIC(40.7,$PIECE(ABMREC,U,3),0)),U),1,20)
+14 IF $PIECE(ABMREC,U,4)'=""
Begin DoDot:2
+15 SET ABMTYP=$PIECE(ABMREC,U,4)
+16 ;W ?55,$P($T(@ABMTYP^ABMUCASH),";;",2) ;abm*2.6*11 insurer type
+17 ;abm*2.6*11 insurer type
WRITE ?55,$$INSTYP^ABMUCASH(ABMTYP)
End DoDot:2
End DoDot:1
+18 WRITE !
+19 ;effective date
+20 KILL DIC,DIE,DA,X,Y
+21 SET DA(1)=ABMLOC
+22 SET DIC="^ABMUXCLD(DA(1),1,"
+23 SET DIC(0)="AEQLV"
+24 DO ^DIC
+25 IF +Y<0
QUIT
+26 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+27 SET ABMEFFDT=+Y
+28 ;everything else
+29 KILL DIC,DIE,DA,X,Y
+30 SET DA(1)=ABMLOC
+31 SET DIE="^ABMUXCLD(DA(1),1,"
+32 SET DA=ABMEFFDT
+33 SET DR=".03;.04;.02"
+34 DO ^DIE
+35 GOTO DISP
+36 QUIT
