ABMVRQUE ;IHS/SD/SDR - Routine to regenerate claims for Riverside ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
;Routine will loop through claims generated under Riverside
;putting the visits back into the ABILL cross reference and
;removing the .04 field (THIRD PARTY BILLED) from the visit
;file so they will regenerate.
;
;ASK for locations to get claims from; this will be used
;for the DUZ(2) of the 3P Claim global root
SITE K ABML
K ^TMP($J)
K DIC,DIE,DA,DR,X,Y
F D Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)!($D(ABML)&(Y<0))
.S DIC="^AUTTLOC("
.S DIC(0)="AEMQZ"
.I $D(ABML) S DIC("A")="Select another site: "
.E S DIC("A")="Select site to requeue visits from: "
.D ^DIC
.Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
.Q:Y<0
.I +Y>0 S ABML(+Y)=""
W !
;
;ASK for date range; just as a safety precaution; it could
;be that the site had claims generating at the satellite at
;one point but doesn't anymore
FROMDT ;
K DIR,DIC,DIE,DA,X,Y
S DIR("A")="Enter Encounter FROM date"
S DIR(0)="D"
D ^DIR
Q:'Y
Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S ABMFROM=+Y
TODT ;
K DIR,DIC,DIE,DA,X,Y
S DIR("A")="Enter Encounter TO date"
S DIR(0)="D"
D ^DIR
Q:'Y
G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) FROMDT
S ABMTO=+Y
I ABMTO<ABMFROM W !!,"TO DATE CAN'T BE AFTER FROM DATE",! G FROMDT
W !
;
DISP ; display selection made
W !,"Ok, I will requeue visits for: "
S ABMI=0
F S ABMI=$O(ABML(ABMI)) Q:+ABMI=0 D
.W !,?5,$P($G(^AUTTLOC(ABMI,0)),U,2)
W !,"for date range ",$$SDT^ABMDUTL(ABMFROM)," thru ",$$SDT^ABMDUTL(ABMTO)
;
PAUSE ;
W !!,"I am now going to loop through and requeue the requested visits"
W !,"and dump the visit info to the screen."
W !!,"PLEASE turn on screen capture to record the visit info."
K DIR,DIC,DIE,X,Y,DA
W ! S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
;
LOOP ;loop thru claims and requeue
W !,"VISIT IEN",?13,"HRN",?20,"S.CAT",?28,"ADMIT DT/TM",?45,"CLN",?65,"LOC",?74,"REVW'D"
S ABMI=0
K ABMALST
F S ABMI=$O(ABML(ABMI)) Q:+ABMI=0 D
.S ABMFDT=ABMFROM-.5
.F S ABMFDT=$O(^ABMDCLM(ABMI,"AD",ABMFDT)) Q:+ABMFDT=0!(ABMFDT>ABMTO) D
..S ABMP("CDFN")=0
..F S ABMP("CDFN")=$O(^ABMDCLM(ABMI,"AD",ABMFDT,ABMP("CDFN"))) Q:+ABMP("CDFN")=0 D
...S ABMP("VDFN")=0
...F S ABMP("VDFN")=$O(^ABMDCLM(ABMI,ABMP("CDFN"),11,ABMP("VDFN"))) Q:+ABMP("VDFN")=0 D
....Q:$D(^TMP($J,ABMP("VDFN"))) ;visit already requeued
....;
....I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),65)) D
.....S D1=0
.....F S D1=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),65,D1)) Q:'D1 D
......I +^ABMDCLM(DUZ(2),ABMP("CDFN"),65,D1,0) S ABMALST(ABMP("CDFN"))=""
.....K D1
....Q:$D(ABMALST(ABMP("CDFN"))) ;an active bill was found; don't cancel
....I '$D(ABMALST(ABMP("CDFN"))) D ENT
....;
....;remove THIRD PARTY BILLED from Visit
....K DIC,DIE,DA,DR,X,Y
....S DIE="^AUPNVSIT("
....S DA=ABMP("VDFN")
....S DR=".04////@"
....D ^DIE
....S ABMDTC=$P($G(^AUPNVSIT(ABMP("VDFN"),0)),U,2)
....S ^AUPNVSIT("ABILL",ABMDTC,ABMP("VDFN"))="" ;Set ABILL X-ref
....S ABMP("PDFN")=$P($G(^AUPNVSIT(ABMP("VDFN"),0)),U,5)
....S ABMSCAT=$P($G(^AUPNVSIT(ABMP("VDFN"),0)),U,7)
....S ABMADTTM=$P($G(^AUPNVSIT(ABMP("VDFN"),0)),U)
....S ABMPCLN=$P($G(^AUPNVSIT(ABMP("VDFN"),0)),U,8)
....S ABMCSTAT=$P($G(^AUPNVSIT(ABMP("VDFN"),11)),U,11)
....S ABMP("LDFN")=$P($G(^AUPNVSIT(ABMP("VDFN"),0)),U,6)
....W !,ABMP("VDFN"),?13,$$HRN^ABMUTL8(ABMP("PDFN")),?22,ABMSCAT
....W ?26,$$CDT^ABMDUTL(ABMADTTM)
....W:+ABMPCLN'=0 ?43,$E($P($G(^DIC(40.7,ABMPCLN,0)),U),1,17)
....W ?62,$E($P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2),1,11)
....W ?77,ABMCSTAT
....S ^TMP($J,ABMP("VDFN"))=""
Q:'$D(ABMALST) ;no active bills were found
W !!,"ACTIVE BILLS WERE FOUND FOR THE FOLLOWING CLAIMS SO THEY WERE NOT REQUEUED"
S ABMI=0
F S ABMI=$O(ABMALST(ABMI)) Q:+ABMI=0 D
.W !,ABMI
XIT ;
Q
;
ENT ;EP - to Cancel a Claim
W !
S DIE="^ABMCCLMS(DUZ(2),"
S DA=ABMP("CDFN")
S DIE("NO^")="OUTOK"
S DR=".04////X;.114////"_DUZ_";.115///NOW;.118////11" ;put OTHER for cancel reason
D ^DIE
I $P($G(^ABMCCLMS(DUZ(2),ABMP("CDFN"),1)),U,8)="" D Q ;cancellation reason
.S DIK="^ABMCCLMS(DUZ(2),"
.S DA=ABMP("CDFN")
.D ^DIK
M ^ABMCCLMS(DUZ(2),ABMP("CDFN"),0)=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
M ^ABMCCLMS(DUZ(2),ABMP("CDFN"),11)=^ABMDCLM(DUZ(2),ABMP("CDFN"),11) ;PCC Visits
M ^ABMCCLMS(DUZ(2),ABMP("CDFN"),41)=^ABMDCLM(DUZ(2),ABMP("CDFN"),41) ;Providers
S DIK="^ABMCCLMS(DUZ(2),"
S DA=ABMP("CDFN")
D IX^DIK ;merged entries don't x-ref
S DR=".04///1" D KCLM
S ^ABMDTMP("KCLM",DT,ABMP("CDFN"))=DUZ
K ^TMP($J)
Q
;
KCLM ;EP for Deleting Claim
S DIK="^ABMDCLM(DUZ(2),"
S DA=ABMP("CDFN")
D ^ABMDEDIK
Q
ABMVRQUE ;IHS/SD/SDR - Routine to regenerate claims for Riverside ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ;Routine will loop through claims generated under Riverside
+4 ;putting the visits back into the ABILL cross reference and
+5 ;removing the .04 field (THIRD PARTY BILLED) from the visit
+6 ;file so they will regenerate.
+7 ;
+8 ;ASK for locations to get claims from; this will be used
+9 ;for the DUZ(2) of the 3P Claim global root
SITE KILL ABML
+1 KILL ^TMP($JOB)
+2 KILL DIC,DIE,DA,DR,X,Y
+3 FOR
Begin DoDot:1
+4 SET DIC="^AUTTLOC("
+5 SET DIC(0)="AEMQZ"
+6 IF $DATA(ABML)
SET DIC("A")="Select another site: "
+7 IF '$TEST
SET DIC("A")="Select site to requeue visits from: "
+8 DO ^DIC
+9 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT
+10 IF Y<0
QUIT
+11 IF +Y>0
SET ABML(+Y)=""
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)!($DATA(ABML)&(Y<0))
QUIT
+12 WRITE !
+13 ;
+14 ;ASK for date range; just as a safety precaution; it could
+15 ;be that the site had claims generating at the satellite at
+16 ;one point but doesn't anymore
FROMDT ;
+1 KILL DIR,DIC,DIE,DA,X,Y
+2 SET DIR("A")="Enter Encounter FROM date"
+3 SET DIR(0)="D"
+4 DO ^DIR
+5 IF 'Y
QUIT
+6 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+7 SET ABMFROM=+Y
TODT ;
+1 KILL DIR,DIC,DIE,DA,X,Y
+2 SET DIR("A")="Enter Encounter TO date"
+3 SET DIR(0)="D"
+4 DO ^DIR
+5 IF 'Y
QUIT
+6 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO FROMDT
+7 SET ABMTO=+Y
+8 IF ABMTO<ABMFROM
WRITE !!,"TO DATE CAN'T BE AFTER FROM DATE",!
GOTO FROMDT
+9 WRITE !
+10 ;
DISP ; display selection made
+1 WRITE !,"Ok, I will requeue visits for: "
+2 SET ABMI=0
+3 FOR
SET ABMI=$ORDER(ABML(ABMI))
IF +ABMI=0
QUIT
Begin DoDot:1
+4 WRITE !,?5,$PIECE($GET(^AUTTLOC(ABMI,0)),U,2)
End DoDot:1
+5 WRITE !,"for date range ",$$SDT^ABMDUTL(ABMFROM)," thru ",$$SDT^ABMDUTL(ABMTO)
+6 ;
PAUSE ;
+1 WRITE !!,"I am now going to loop through and requeue the requested visits"
+2 WRITE !,"and dump the visit info to the screen."
+3 WRITE !!,"PLEASE turn on screen capture to record the visit info."
+4 KILL DIR,DIC,DIE,X,Y,DA
+5 WRITE !
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
+6 ;
LOOP ;loop thru claims and requeue
+1 WRITE !,"VISIT IEN",?13,"HRN",?20,"S.CAT",?28,"ADMIT DT/TM",?45,"CLN",?65,"LOC",?74,"REVW'D"
+2 SET ABMI=0
+3 KILL ABMALST
+4 FOR
SET ABMI=$ORDER(ABML(ABMI))
IF +ABMI=0
QUIT
Begin DoDot:1
+5 SET ABMFDT=ABMFROM-.5
+6 FOR
SET ABMFDT=$ORDER(^ABMDCLM(ABMI,"AD",ABMFDT))
IF +ABMFDT=0!(ABMFDT>ABMTO)
QUIT
Begin DoDot:2
+7 SET ABMP("CDFN")=0
+8 FOR
SET ABMP("CDFN")=$ORDER(^ABMDCLM(ABMI,"AD",ABMFDT,ABMP("CDFN")))
IF +ABMP("CDFN")=0
QUIT
Begin DoDot:3
+9 SET ABMP("VDFN")=0
+10 FOR
SET ABMP("VDFN")=$ORDER(^ABMDCLM(ABMI,ABMP("CDFN"),11,ABMP("VDFN")))
IF +ABMP("VDFN")=0
QUIT
Begin DoDot:4
+11 ;visit already requeued
IF $DATA(^TMP($JOB,ABMP("VDFN")))
QUIT
+12 ;
+13 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),65))
Begin DoDot:5
+14 SET D1=0
+15 FOR
SET D1=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),65,D1))
IF 'D1
QUIT
Begin DoDot:6
+16 IF +^ABMDCLM(DUZ(2),ABMP("CDFN"),65,D1,0)
SET ABMALST(ABMP("CDFN"))=""
End DoDot:6
+17 KILL D1
End DoDot:5
+18 ;an active bill was found; don't cancel
IF $DATA(ABMALST(ABMP("CDFN")))
QUIT
+19 IF '$DATA(ABMALST(ABMP("CDFN")))
DO ENT
+20 ;
+21 ;remove THIRD PARTY BILLED from Visit
+22 KILL DIC,DIE,DA,DR,X,Y
+23 SET DIE="^AUPNVSIT("
+24 SET DA=ABMP("VDFN")
+25 SET DR=".04////@"
+26 DO ^DIE
+27 SET ABMDTC=$PIECE($GET(^AUPNVSIT(ABMP("VDFN"),0)),U,2)
+28 ;Set ABILL X-ref
SET ^AUPNVSIT("ABILL",ABMDTC,ABMP("VDFN"))=""
+29 SET ABMP("PDFN")=$PIECE($GET(^AUPNVSIT(ABMP("VDFN"),0)),U,5)
+30 SET ABMSCAT=$PIECE($GET(^AUPNVSIT(ABMP("VDFN"),0)),U,7)
+31 SET ABMADTTM=$PIECE($GET(^AUPNVSIT(ABMP("VDFN"),0)),U)
+32 SET ABMPCLN=$PIECE($GET(^AUPNVSIT(ABMP("VDFN"),0)),U,8)
+33 SET ABMCSTAT=$PIECE($GET(^AUPNVSIT(ABMP("VDFN"),11)),U,11)
+34 SET ABMP("LDFN")=$PIECE($GET(^AUPNVSIT(ABMP("VDFN"),0)),U,6)
+35 WRITE !,ABMP("VDFN"),?13,$$HRN^ABMUTL8(ABMP("PDFN")),?22,ABMSCAT
+36 WRITE ?26,$$CDT^ABMDUTL(ABMADTTM)
+37 IF +ABMPCLN'=0
WRITE ?43,$EXTRACT($PIECE($GET(^DIC(40.7,ABMPCLN,0)),U),1,17)
+38 WRITE ?62,$EXTRACT($PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,2),1,11)
+39 WRITE ?77,ABMCSTAT
+40 SET ^TMP($JOB,ABMP("VDFN"))=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+41 ;no active bills were found
IF '$DATA(ABMALST)
QUIT
+42 WRITE !!,"ACTIVE BILLS WERE FOUND FOR THE FOLLOWING CLAIMS SO THEY WERE NOT REQUEUED"
+43 SET ABMI=0
+44 FOR
SET ABMI=$ORDER(ABMALST(ABMI))
IF +ABMI=0
QUIT
Begin DoDot:1
+45 WRITE !,ABMI
End DoDot:1
XIT ;
+1 QUIT
+2 ;
ENT ;EP - to Cancel a Claim
+1 WRITE !
+2 SET DIE="^ABMCCLMS(DUZ(2),"
+3 SET DA=ABMP("CDFN")
+4 SET DIE("NO^")="OUTOK"
+5 ;put OTHER for cancel reason
SET DR=".04////X;.114////"_DUZ_";.115///NOW;.118////11"
+6 DO ^DIE
+7 ;cancellation reason
IF $PIECE($GET(^ABMCCLMS(DUZ(2),ABMP("CDFN"),1)),U,8)=""
Begin DoDot:1
+8 SET DIK="^ABMCCLMS(DUZ(2),"
+9 SET DA=ABMP("CDFN")
+10 DO ^DIK
End DoDot:1
QUIT
+11 MERGE ^ABMCCLMS(DUZ(2),ABMP("CDFN"),0)=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
+12 ;PCC Visits
MERGE ^ABMCCLMS(DUZ(2),ABMP("CDFN"),11)=^ABMDCLM(DUZ(2),ABMP("CDFN"),11)
+13 ;Providers
MERGE ^ABMCCLMS(DUZ(2),ABMP("CDFN"),41)=^ABMDCLM(DUZ(2),ABMP("CDFN"),41)
+14 SET DIK="^ABMCCLMS(DUZ(2),"
+15 SET DA=ABMP("CDFN")
+16 ;merged entries don't x-ref
DO IX^DIK
+17 SET DR=".04///1"
DO KCLM
+18 SET ^ABMDTMP("KCLM",DT,ABMP("CDFN"))=DUZ
+19 KILL ^TMP($JOB)
+20 QUIT
+21 ;
KCLM ;EP for Deleting Claim
+1 SET DIK="^ABMDCLM(DUZ(2),"
+2 SET DA=ABMP("CDFN")
+3 DO ^ABMDEDIK
+4 QUIT
