ABMDICST ; IHS/SD/TPF - Pending Claims Status Report ; JUN 29, 2005
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; IHS/SD/SDR - V2.5 P10 - IM21520
; Added code to allow no date range selection
;
EN ;EP - PENDING CLAIMS STATUS REPORT
K ABM,ABMY
S ABM("RTYP")=1,ABM("RTYP","NM")="BRIEF LISTING (80 Width)"
S ABM("STA")="P"
;cancelled claims
S ABM("DT")="V" ;by visit date
S ABM("SORT")="C"
S ABM("L")=DUZ(2)
S ABM("STA","NM")="PENDING STATUS"
S ABM("REASON")="PEND" ;flag for RTYP^ABMDRSL2 to not ask for EXTENDED
SEL S ABM("NODX")="" D ^ABMDRSEL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S ABM("HD",0)="PENDING CLAIMS STATUS LISTING"
D ^ABMDRHD
S ABMQ("RC")="COMPUTE^ABMDICST",ABMQ("RX")="POUT^ABMDRUTL",ABMQ("NS")="ABM"
S ABMQ("RP")="PRINT^ABMDPST"_ABM("RTYP")
D ^ABMDRDBQ
Q
;
COMPUTE ;EP - Entry Point for Setting up Data
S ABM("SUBR")="ABM-ICS" K ^TMP("ABM-ICS",$J) Q:'$D(ABM("STA")) S ABM("PG")=0
D SLOOP
Q
SLOOP ;EP - LOOP TO PULL PENDING CLAIMS
I $D(ABMY("DT")) D Q
.S ABM("RD")=ABMY("DT",1)-1
.F S ABM("RD")=$O(^ABMDCLM(DUZ(2),"AD",ABM("RD"))) Q:'+ABM("RD")!($P(ABM("RD"),".")>ABMY("DT",2)) D
..S ABM=""
..F S ABM=$O(^ABMDCLM(DUZ(2),"AD",ABM("RD"),ABM)) Q:'ABM D DATA
S ABMP=0
F S ABMP=$O(^ABMDCLM(DUZ(2),"AS",ABMP)) Q:ABMP="" D
.S ABM=0
.F S ABM=$O(^ABMDCLM(DUZ(2),"AS",ABMP,ABM)) Q:'ABM D DATA
Q
;
DATA ;EP - COMPILE DATA FOR PENDING CLAIM STATUS
S ABMP("HIT")=0
D INCOM^ABMDRCHK(ABM,.ABM,.ABMY)
Q:'ABMP("HIT")
S ABM("SORT")=$S($G(ABMY("SORT"))="C":$G(ABM("CLINIC")),1:$G(ABM("VISIT TYPE")))
S:ABM("SORT")="" ABM("SORT")="UNDEFINED"
S ABM("HRN")=$S($G(ABM("PATIENT"))'="":$P($G(^AUPNPAT(ABM("PATIENT"),41,ABM("L"),0)),U,2),1:"UNDEFINED")
S ABM("LOCATION NAME")=$S($G(ABM("LOCATION"))'="":$P($G(^DIC(4,ABM("LOCATION"),0)),U),1:"UNDEFINED")
S SUBSCRIP=$G(ABM("LOCATION NAME"))_U_$G(ABM("SORT"))
S SUBSCRIP=SUBSCRIP_U_$S($G(ABM("PATIENT"))="":"",1:$P($G(^DPT(ABM("PATIENT"),0)),U))
S SUBSCRIP=SUBSCRIP_U_$G(ABM("HRN"))_U_$G(ABM)_U_$G(ABM("VISIT TYPE"))
S SUBSCRIP=SUBSCRIP_U_$G(ABM("CLINIC"))_U_$G(ABM("PS REASON"))_U_$G(ABM("VISIT DATE"))
S SUBSCRIP=SUBSCRIP_U_$G(ABM("ACTIVE INSURER"))_U_$G(ABM("PS UPDATER"))
S ^TMP("ABM-ICS",$J,SUBSCRIP)=""
S ABM("ST",ABM("LOCATION NAME"),ABM("PS UPDATER"),ABM("SORT"),ABM("ACTIVE INSURER"),ABM("PS REASON"))=+$G(ABM("ST",ABM("LOCATION NAME"),ABM("PS UPDATER"),ABM("SORT"),ABM("ACTIVE INSURER"),ABM("PS REASON")))+1
Q
;CALL THIS TAG TO SET UP SOME CLAIMS FOR TESTING
TEST ;
S CNT=0
S FAC=0
F S FAC=$O(^ABMDCLM(FAC)) Q:'FAC D
.S CLAIM=0,CNT=0
.F S CLAIM=$O(^ABMDCLM(FAC,CLAIM)) Q:'CLAIM!(CNT>30) D
..S RANDUZ=$R(400)
..Q:RANDUZ=0
..Q:'$D(^VA(200,RANDUZ))
..S RANREAS=$R(18)
..Q:RANREAS=0
..Q:'$D(^ABMPSTAT(RANREAS))
..S CNT=CNT+1
..S $P(^ABMDCLM(FAC,CLAIM,0),U,4)="P"
..S $P(^ABMDCLM(FAC,CLAIM,0),U,19)=RANDUZ
..S $P(^ABMDCLM(FAC,CLAIM,0),U,18)=RANREAS
..W !,FAC,"--",CLAIM
Q
QPRT ;
S FAC=0
F S FAC=$O(^ABMDCLM(FAC)) Q:'FAC D
.S CLAIM=0
.F S CLAIM=$O(^ABMDCLM(FAC,CLAIM)) Q:'CLAIM D
..I $P($G(^ABMDCLM(FAC,CLAIM,0)),U,19)'="",($P($G(^ABMDCLM(FAC,CLAIM,0)),U,4)="P") D
...W !,FAC,"--",CLAIM,"--",$P($G(^ABMDCLM(FAC,CLAIM,0)),U,2)
...W:$P(^ABMDCLM(FAC,CLAIM,0),U,18)="" "*"
Q
ABMDICST ; IHS/SD/TPF - Pending Claims Status Report ; JUN 29, 2005
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; IHS/SD/SDR - V2.5 P10 - IM21520
+4 ; Added code to allow no date range selection
+5 ;
EN ;EP - PENDING CLAIMS STATUS REPORT
+1 KILL ABM,ABMY
+2 SET ABM("RTYP")=1
SET ABM("RTYP","NM")="BRIEF LISTING (80 Width)"
+3 SET ABM("STA")="P"
+4 ;cancelled claims
+5 ;by visit date
SET ABM("DT")="V"
+6 SET ABM("SORT")="C"
+7 SET ABM("L")=DUZ(2)
+8 SET ABM("STA","NM")="PENDING STATUS"
+9 ;flag for RTYP^ABMDRSL2 to not ask for EXTENDED
SET ABM("REASON")="PEND"
SEL SET ABM("NODX")=""
DO ^ABMDRSEL
IF $DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
QUIT
+1 SET ABM("HD",0)="PENDING CLAIMS STATUS LISTING"
+2 DO ^ABMDRHD
+3 SET ABMQ("RC")="COMPUTE^ABMDICST"
SET ABMQ("RX")="POUT^ABMDRUTL"
SET ABMQ("NS")="ABM"
+4 SET ABMQ("RP")="PRINT^ABMDPST"_ABM("RTYP")
+5 DO ^ABMDRDBQ
+6 QUIT
+7 ;
COMPUTE ;EP - Entry Point for Setting up Data
+1 SET ABM("SUBR")="ABM-ICS"
KILL ^TMP("ABM-ICS",$JOB)
IF '$DATA(ABM("STA"))
QUIT
SET ABM("PG")=0
+2 DO SLOOP
+3 QUIT
SLOOP ;EP - LOOP TO PULL PENDING CLAIMS
+1 IF $DATA(ABMY("DT"))
Begin DoDot:1
+2 SET ABM("RD")=ABMY("DT",1)-1
+3 FOR
SET ABM("RD")=$ORDER(^ABMDCLM(DUZ(2),"AD",ABM("RD")))
IF '+ABM("RD")!($PIECE(ABM("RD"),".")>ABMY("DT",2))
QUIT
Begin DoDot:2
+4 SET ABM=""
+5 FOR
SET ABM=$ORDER(^ABMDCLM(DUZ(2),"AD",ABM("RD"),ABM))
IF 'ABM
QUIT
DO DATA
End DoDot:2
End DoDot:1
QUIT
+6 SET ABMP=0
+7 FOR
SET ABMP=$ORDER(^ABMDCLM(DUZ(2),"AS",ABMP))
IF ABMP=""
QUIT
Begin DoDot:1
+8 SET ABM=0
+9 FOR
SET ABM=$ORDER(^ABMDCLM(DUZ(2),"AS",ABMP,ABM))
IF 'ABM
QUIT
DO DATA
End DoDot:1
+10 QUIT
+11 ;
DATA ;EP - COMPILE DATA FOR PENDING CLAIM STATUS
+1 SET ABMP("HIT")=0
+2 DO INCOM^ABMDRCHK(ABM,.ABM,.ABMY)
+3 IF 'ABMP("HIT")
QUIT
+4 SET ABM("SORT")=$SELECT($GET(ABMY("SORT"))="C":$GET(ABM("CLINIC")),1:$GET(ABM("VISIT TYPE")))
+5 IF ABM("SORT")=""
SET ABM("SORT")="UNDEFINED"
+6 SET ABM("HRN")=$SELECT($GET(ABM("PATIENT"))'="":$PIECE($GET(^AUPNPAT(ABM("PATIENT"),41,ABM("L"),0)),U,2),1:"UNDEFINED")
+7 SET ABM("LOCATION NAME")=$SELECT($GET(ABM("LOCATION"))'="":$PIECE($GET(^DIC(4,ABM("LOCATION"),0)),U),1:"UNDEFINED")
+8 SET SUBSCRIP=$GET(ABM("LOCATION NAME"))_U_$GET(ABM("SORT"))
+9 SET SUBSCRIP=SUBSCRIP_U_$SELECT($GET(ABM("PATIENT"))="":"",1:$PIECE($GET(^DPT(ABM("PATIENT"),0)),U))
+10 SET SUBSCRIP=SUBSCRIP_U_$GET(ABM("HRN"))_U_$GET(ABM)_U_$GET(ABM("VISIT TYPE"))
+11 SET SUBSCRIP=SUBSCRIP_U_$GET(ABM("CLINIC"))_U_$GET(ABM("PS REASON"))_U_$GET(ABM("VISIT DATE"))
+12 SET SUBSCRIP=SUBSCRIP_U_$GET(ABM("ACTIVE INSURER"))_U_$GET(ABM("PS UPDATER"))
+13 SET ^TMP("ABM-ICS",$JOB,SUBSCRIP)=""
+14 SET ABM("ST",ABM("LOCATION NAME"),ABM("PS UPDATER"),ABM("SORT"),ABM("ACTIVE INSURER"),ABM("PS REASON"))=+$GET(ABM("ST",ABM("LOCATION NAME"),ABM("PS UPDATER"),ABM("SORT"),ABM("ACTIVE INSURER"),ABM("PS REASON")))+1
+15 QUIT
+16 ;CALL THIS TAG TO SET UP SOME CLAIMS FOR TESTING
TEST ;
+1 SET CNT=0
+2 SET FAC=0
+3 FOR
SET FAC=$ORDER(^ABMDCLM(FAC))
IF 'FAC
QUIT
Begin DoDot:1
+4 SET CLAIM=0
SET CNT=0
+5 FOR
SET CLAIM=$ORDER(^ABMDCLM(FAC,CLAIM))
IF 'CLAIM!(CNT>30)
QUIT
Begin DoDot:2
+6 SET RANDUZ=$RANDOM(400)
+7 IF RANDUZ=0
QUIT
+8 IF '$DATA(^VA(200,RANDUZ))
QUIT
+9 SET RANREAS=$RANDOM(18)
+10 IF RANREAS=0
QUIT
+11 IF '$DATA(^ABMPSTAT(RANREAS))
QUIT
+12 SET CNT=CNT+1
+13 SET $PIECE(^ABMDCLM(FAC,CLAIM,0),U,4)="P"
+14 SET $PIECE(^ABMDCLM(FAC,CLAIM,0),U,19)=RANDUZ
+15 SET $PIECE(^ABMDCLM(FAC,CLAIM,0),U,18)=RANREAS
+16 WRITE !,FAC,"--",CLAIM
End DoDot:2
End DoDot:1
+17 QUIT
QPRT ;
+1 SET FAC=0
+2 FOR
SET FAC=$ORDER(^ABMDCLM(FAC))
IF 'FAC
QUIT
Begin DoDot:1
+3 SET CLAIM=0
+4 FOR
SET CLAIM=$ORDER(^ABMDCLM(FAC,CLAIM))
IF 'CLAIM
QUIT
Begin DoDot:2
+5 IF $PIECE($GET(^ABMDCLM(FAC,CLAIM,0)),U,19)'=""
IF ($PIECE($GET(^ABMDCLM(FAC,CLAIM,0)),U,4)="P")
Begin DoDot:3
+6 WRITE !,FAC,"--",CLAIM,"--",$PIECE($GET(^ABMDCLM(FAC,CLAIM,0)),U,2)
+7 IF $PIECE(^ABMDCLM(FAC,CLAIM,0),U,18)=""
WRITE "*"
End DoDot:3
End DoDot:2
End DoDot:1
+8 QUIT
