- ABMELGCK ; IHS/SD/SDR - Recreate cancelled claim from PCC ;
- ;;2.6;IHS 3P BILLING SYSTEM;**14,21**;NOV 12, 2009;Build 379
- ;Allows user to look up eligibility for visit by patient
- ;This runs "eligiblity checker" portion of CG and outputs
- ;ABML array of info found
- ;IHS/SD/SDR - 2.6*21 - HEAT123571 - defined ABMP("VDT") to stop <UNDEF>OPCK+13^ABMDVCK1 error
- ;IHS/SD/SDR - 2.6*21 - HEAT137034 - Added visit type to display
- ;
- START ;EP
- S DIC="^AUPNPAT("
- S DIC(0)="AEMQ"
- S DIC("S")="I $D(^AUPNVSIT(""AC"",Y))"
- D ^DIC
- I Y<0 G Q
- S ABMPDFN=+Y
- S DIC="^AUPNVSIT("
- S DIC(0)="AEQ"
- S DIC("S")="I $D(^AUPNVSIT(""AC"",DFN,Y))&'$P(^AUPNVSIT(Y,0),U,11)"
- D ^DIC
- I Y<0 G Q
- S ABMVDFN=+Y
- ;S ABMVDT=+$P($G(^AUPNVSIT(ABMVDFN,0)),U) ;abm*2.6*21 IHS/SD/SDR HEAT123571
- S (ABMVDT,ABMP("VDT"))=+$P($G(^AUPNVSIT(ABMVDFN,0)),U) ;abm*2.6*21 IHS/SD/SDR HEAT123571
- S ABMSERVC=$P($G(^AUPNVSIT(ABMVDFN,0)),U,7) ;abm*2.6*21 IHS/SD/SDR HEAT137034
- S ABMCLN=$$GET1^DIQ(40.7,$P($G(^AUPNVSIT(ABMVDFN,0)),U,8),1,"E") ;abm*2.6*21 IHS/SD/SDR HEAT137034
- S ABML=""
- D ELG^ABMDLCK(ABMVDFN,.ABML,ABMPDFN,ABMVDT)
- ;
- W !!
- W !,"For patient ",$P($G(^DPT(ABMPDFN,0)),U),", for visit ",$$CDT^ABMDUTL($P($G(^AUPNVSIT(ABMVDFN,0)),U)),!
- ;W "PRIORITY",?9,"INSURER",?37,"STATUS",?50,"REASON UNBILLABLE",! ;abm*2.6*21 IHS/SD/SDR HEAT137034
- W "PRIORITY",?9,"INSURER",?37,"VTYP",?42,"STATUS",?53,"REASON UNBILLABLE",! ;abm*2.6*21 IHS/SD/SDR HEAT137034
- F A=1:1:80 W "-"
- W !
- S ABMPRI=0
- K ABME
- F S ABMPRI=$O(ABML(ABMPRI)) Q:+ABMPRI=0 D
- .S ABMINS=0
- .F S ABMINS=$O(ABML(ABMPRI,ABMINS)) Q:+ABMINS=0 D
- ..W ?2,ABMPRI
- ..W ?9,$E($P($G(^AUTNINS(ABMINS,0)),U),1,20)_"("_ABMINS_")"
- ..W ?37,$$VTYP^ABMDVCK1(ABMVDFN,ABMSERVC,ABMINS,ABMCLN) ;abm*2.6*21 IHS/SD/SDR HEAT137034
- ..;W ?37,$S(+$P(ABML(ABMPRI,ABMINS),U,6):"UNBILLABLE",1:"BILLABLE") ;abm*2.6*21 IHS/SD/SDR HEAT137034
- ..W ?42,$S(+$P(ABML(ABMPRI,ABMINS),U,6):"UNBILLABLE",1:"BILLABLE") ;abm*2.6*21 IHS/SD/SDR HEAT137034
- ..;W:$P(ABML(ABMPRI,ABMINS),U,6) ?50,"("_$P(ABML(ABMPRI,ABMINS),U,6)_")",$E($P($G(^ABMDCS($P(ABML(ABMPRI,ABMINS),U,6),0)),U),1,26) ;abm*2.6*21 IHS/SD/SDR HEAT137034
- ..W:$P(ABML(ABMPRI,ABMINS),U,6) ?53,"("_$P(ABML(ABMPRI,ABMINS),U,6)_")",$E($P($G(^ABMDCS($P(ABML(ABMPRI,ABMINS),U,6),0)),U),1,23) ;abm*2.6*21 IHS/SD/SDR HEAT137034
- ..W !
- ..Q:($P(ABML(ABMPRI,ABMINS),U,6)="")
- ..S ABME($P(ABML(ABMPRI,ABMINS),U,6))=""
- W !!
- I $D(ABME) D
- .W ?1,"REASON UNBILLABLE KEY:"
- .S ABMA=0
- .F S ABMA=$O(ABME(ABMA)) Q:+ABMA=0 D
- ..W !?3,ABMA_" - ",$P($G(^ABMDCS(ABMA,0)),U)
- .W !
- G START
- ;
- Q K DIC,DIE,ABMV,DR
- Q
- ABMELGCK ; IHS/SD/SDR - Recreate cancelled claim from PCC ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;**14,21**;NOV 12, 2009;Build 379
- +2 ;Allows user to look up eligibility for visit by patient
- +3 ;This runs "eligiblity checker" portion of CG and outputs
- +4 ;ABML array of info found
- +5 ;IHS/SD/SDR - 2.6*21 - HEAT123571 - defined ABMP("VDT") to stop <UNDEF>OPCK+13^ABMDVCK1 error
- +6 ;IHS/SD/SDR - 2.6*21 - HEAT137034 - Added visit type to display
- +7 ;
- START ;EP
- +1 SET DIC="^AUPNPAT("
- +2 SET DIC(0)="AEMQ"
- +3 SET DIC("S")="I $D(^AUPNVSIT(""AC"",Y))"
- +4 DO ^DIC
- +5 IF Y<0
- GOTO Q
- +6 SET ABMPDFN=+Y
- +7 SET DIC="^AUPNVSIT("
- +8 SET DIC(0)="AEQ"
- +9 SET DIC("S")="I $D(^AUPNVSIT(""AC"",DFN,Y))&'$P(^AUPNVSIT(Y,0),U,11)"
- +10 DO ^DIC
- +11 IF Y<0
- GOTO Q
- +12 SET ABMVDFN=+Y
- +13 ;S ABMVDT=+$P($G(^AUPNVSIT(ABMVDFN,0)),U) ;abm*2.6*21 IHS/SD/SDR HEAT123571
- +14 ;abm*2.6*21 IHS/SD/SDR HEAT123571
- SET (ABMVDT,ABMP("VDT"))=+$PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U)
- +15 ;abm*2.6*21 IHS/SD/SDR HEAT137034
- SET ABMSERVC=$PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U,7)
- +16 ;abm*2.6*21 IHS/SD/SDR HEAT137034
- SET ABMCLN=$$GET1^DIQ(40.7,$PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U,8),1,"E")
- +17 SET ABML=""
- +18 DO ELG^ABMDLCK(ABMVDFN,.ABML,ABMPDFN,ABMVDT)
- +19 ;
- +20 WRITE !!
- +21 WRITE !,"For patient ",$PIECE($GET(^DPT(ABMPDFN,0)),U),", for visit ",$$CDT^ABMDUTL($PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U)),!
- +22 ;W "PRIORITY",?9,"INSURER",?37,"STATUS",?50,"REASON UNBILLABLE",! ;abm*2.6*21 IHS/SD/SDR HEAT137034
- +23 ;abm*2.6*21 IHS/SD/SDR HEAT137034
- WRITE "PRIORITY",?9,"INSURER",?37,"VTYP",?42,"STATUS",?53,"REASON UNBILLABLE",!
- +24 FOR A=1:1:80
- WRITE "-"
- +25 WRITE !
- +26 SET ABMPRI=0
- +27 KILL ABME
- +28 FOR
- SET ABMPRI=$ORDER(ABML(ABMPRI))
- IF +ABMPRI=0
- QUIT
- Begin DoDot:1
- +29 SET ABMINS=0
- +30 FOR
- SET ABMINS=$ORDER(ABML(ABMPRI,ABMINS))
- IF +ABMINS=0
- QUIT
- Begin DoDot:2
- +31 WRITE ?2,ABMPRI
- +32 WRITE ?9,$EXTRACT($PIECE($GET(^AUTNINS(ABMINS,0)),U),1,20)_"("_ABMINS_")"
- +33 ;abm*2.6*21 IHS/SD/SDR HEAT137034
- WRITE ?37,$$VTYP^ABMDVCK1(ABMVDFN,ABMSERVC,ABMINS,ABMCLN)
- +34 ;W ?37,$S(+$P(ABML(ABMPRI,ABMINS),U,6):"UNBILLABLE",1:"BILLABLE") ;abm*2.6*21 IHS/SD/SDR HEAT137034
- +35 ;abm*2.6*21 IHS/SD/SDR HEAT137034
- WRITE ?42,$SELECT(+$PIECE(ABML(ABMPRI,ABMINS),U,6):"UNBILLABLE",1:"BILLABLE")
- +36 ;W:$P(ABML(ABMPRI,ABMINS),U,6) ?50,"("_$P(ABML(ABMPRI,ABMINS),U,6)_")",$E($P($G(^ABMDCS($P(ABML(ABMPRI,ABMINS),U,6),0)),U),1,26) ;abm*2.6*21 IHS/SD/SDR HEAT137034
- +37 ;abm*2.6*21 IHS/SD/SDR HEAT137034
- IF $PIECE(ABML(ABMPRI,ABMINS),U,6)
- WRITE ?53,"("_$PIECE(ABML(ABMPRI,ABMINS),U,6)_")",$EXTRACT($PIECE($GET(^ABMDCS($PIECE(ABML(ABMPRI,ABMINS),U,6),0)),U),1,23)
- +38 WRITE !
- +39 IF ($PIECE(ABML(ABMPRI,ABMINS),U,6)="")
- QUIT
- +40 SET ABME($PIECE(ABML(ABMPRI,ABMINS),U,6))=""
- End DoDot:2
- End DoDot:1
- +41 WRITE !!
- +42 IF $DATA(ABME)
- Begin DoDot:1
- +43 WRITE ?1,"REASON UNBILLABLE KEY:"
- +44 SET ABMA=0
- +45 FOR
- SET ABMA=$ORDER(ABME(ABMA))
- IF +ABMA=0
- QUIT
- Begin DoDot:2
- +46 WRITE !?3,ABMA_" - ",$PIECE($GET(^ABMDCS(ABMA,0)),U)
- End DoDot:2
- +47 WRITE !
- End DoDot:1
- +48 GOTO START
- +49 ;
- Q KILL DIC,DIE,ABMV,DR
- +1 QUIT
