- 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
