- 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
