Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMM2P10

ABMM2P10.m

Go to the documentation of this file. 
  1. ABMM2P10 ;IHS/SD/SDR - MU Patient Volume EP Report ;
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**15**;NOV 12, 2009;Build 251
  1.  ;IHS/SD/SDR - 2.6*15 - HEAT161159 - Changed PT LST to sort differently so there won't be duplicate vsts on pt lst.
  1.  ;IHS/SD/SDR - 2.6*15 - HEAT174501 - Added Provider NPI to host file
  1.  ;IHS/SD/SDR - 2.6*15 - HEAT171490 - Added facility NPI and TIN to pt list host file
  1.  ;IHS/SD/SDR - 2.6*15 - HEAT183289 - Added Tribal self-insured flag to output and summary total lines
  1.  ;IHS/SD/SDR - 2.6*15 - HEAT188548- format visit time to 4 digits
  1.  ;
  1. PATIENT ;EP
  1.  I ABMY("RFMT")="P",$G(ABMFN)'="" D PTHSTFL Q
  1.  S ABM("PG")=1
  1.  S ABMSDT=$P($G(^XTMP("ABM-PVP2",$J,"PRV TOP")),U,2)
  1.  D HDR^ABMM2PV3
  1.  Q:ABMSDT=""
  1.  S ABMVLOC=0
  1.  F  S ABMVLOC=$O(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC)) Q:'ABMVLOC  D  Q:(IOST["C")&((+$G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
  1.  .D PTHDR^ABMM2PV3
  1.  .;start old abm*2.6*15 HEAT161159
  1.  .;S ABMITYP=""
  1.  .;F  S ABMITYP=$O(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMITYP)) Q:ABMITYP=""  D  Q:(IOST["C")&((+$G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
  1.  .;.S ABMINS=""
  1.  .;.F  S ABMINS=$O(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMITYP,ABMINS)) Q:ABMINS=""  D  Q:(IOST["C")&((+$G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
  1.  .;..S ABMPTL=""
  1.  .;..F  S ABMPTL=$O(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMITYP,ABMINS,ABMPTL)) Q:ABMPTL=""  D  Q:(IOST["C")&((+$G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
  1.  .;...S ABMPTF=""
  1.  .;...F  S ABMPTF=$O(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMITYP,ABMINS,ABMPTL,ABMPTF)) Q:ABMPTF=""  D  Q:(IOST["C")&((+$G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
  1.  .;....S ABMVDT=0
  1.  .;....F  S ABMVDT=$O(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMITYP,ABMINS,ABMPTL,ABMPTF,ABMVDT)) Q:'ABMVDT  D  Q:(IOST["C")&((+$G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
  1.  .;.....S ABMVDFN=0
  1.  .;.....F  S ABMVDFN=$O(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMITYP,ABMINS,ABMPTL,ABMPTF,ABMVDT,ABMVDFN)) Q:'ABMVDFN  D  Q:(IOST["C")&((+$G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
  1.  .;......S ABMPT=$P($G(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMITYP,ABMINS,ABMPTL,ABMPTF,ABMVDT,ABMVDFN)),U,2)
  1.  .;......S ABMTRIEN=$P($G(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMITYP,ABMINS,ABMPTL,ABMPTF,ABMVDT,ABMVDFN)),U,3)
  1.  .;......S IENS=ABMVLOC_","_ABMPT_","
  1.  .;......S ABMHRN=$$GET1^DIQ(9000001.41,IENS,.02)
  1.  .;......W !,$E(ABMPTL_", "_ABMPTF,1,16)  ;pt name
  1.  .;......W ?18,ABMHRN  ;HRN
  1.  .;......W ?25,$E($$GET1^DIQ(9000010,ABMVDFN,.07,"E"),1,3)  ;Cat
  1.  .;......W ?29,$E($$GET1^DIQ(9000010,ABMVDFN,.08,"E"),1,8)  ;clin
  1.  .;......W ?39,$S(ABMITYP="X":"",1:ABMITYP)  ;itype
  1.  .;......W ?42,$S(ABMINS="NO BILL":"NOT BILLED",1:$E(ABMINS,1,10))  ;ins
  1.  .;......W ?53,$$CDT^ABMDUTL(ABMVDT)  ;vst dt
  1.  .;......W ?70,$S(+ABMTRIEN:$$SDTO^ABMDUTL(ABMTRIEN),1:"") ;dt pd
  1.  .;......I $P($G(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMITYP,ABMINS,ABMPTL,ABMPTF,ABMVDT,ABMVDFN)),U,4)'="" W ?79,$P(^(ABMVDFN),U,4)
  1.  .;......I $Y+5>IOSL D HD^ABMM2PV3,PTHDR^ABMM2PV3 Q:(IOST["C")&((+$G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
  1.  .;end old start new HEAT161159
  1.  .S ABMVDT=0
  1.  .F  S ABMVDT=$O(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMVDT)) Q:'ABMVDT  D  Q:(IOST["C")&((+$G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
  1.  ..S ABMVDFN=0
  1.  ..F  S ABMVDFN=$O(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMVDT,ABMVDFN)) Q:'ABMVDFN  D  Q:(IOST["C")&((+$G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
  1.  ...S ABMPT=$P($G(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMVDT,ABMVDFN)),U,2)
  1.  ...S ABMTRIEN=$P($G(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMVDT,ABMVDFN)),U,3)
  1.  ...S ABMPTL=$P($G(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMVDT,ABMVDFN)),U,10)
  1.  ...S ABMPTF=$P($G(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMVDT,ABMVDFN)),U,11)
  1.  ...S ABMITYP=$P($G(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMVDT,ABMVDFN)),U,8)  ;abm*2.6*15
  1.  ...S ABMINS=$P($G(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMVDT,ABMVDFN)),U,9)  ;abm*2.6*15
  1.  ...S IENS=ABMVLOC_","_ABMPT_","
  1.  ...S ABMHRN=$$GET1^DIQ(9000001.41,IENS,.02)
  1.  ...W !,$E(ABMPTL_", "_ABMPTF,1,16)  ;pt name
  1.  ...W ?18,ABMHRN  ;HRN
  1.  ...W ?25,$E($$GET1^DIQ(9000010,ABMVDFN,.07,"E"),1,3)  ;Cat
  1.  ...W ?29,$E($$GET1^DIQ(9000010,ABMVDFN,.08,"E"),1,8)  ;clin
  1.  ...W ?39,$S(ABMITYP="X":"",1:ABMITYP)  ;itype
  1.  ...W ?42,$S(ABMINS="NO BILL":"NOT BILLED",1:$E(ABMINS,1,10))  ;ins
  1.  ...W ?53,$$CDT^ABMDUTL(ABMVDT)  ;vst dt
  1.  ...W ?70,$S(+ABMTRIEN:$$SDTO^ABMDUTL(ABMTRIEN),1:"") ;dt pd
  1.  ...I $P($G(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMVDT,ABMVDFN)),U,4)'="" W ?79,$P(^(ABMVDFN),U,4)
  1.  ...I $Y+5>IOSL D HD^ABMM2PV3,PTHDR^ABMM2PV3 Q:(IOST["C")&((+$G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
  1.  ;end new HEAT161159
  1.  Q
  1. PTHSTFL ;EP
  1.  S ABMSDT=$P($G(^XTMP("ABM-PVP2",$J,"PRV TOP")),U,2)
  1.  K ABMDCNT
  1.  D OPEN^%ZISH("ABM",ABMPATH,ABMFN,"W")
  1.  Q:POP
  1.  U IO
  1.  S ABM("PG")=1
  1.  D HDR^ABMM2PV3
  1.  ;W !,"Visit Location"_U_"Patient"_U_"Chart#"_U_"Policy Holder ID"_U_"Serv Cat"_U_"Clinic"_U_"InsType"_U_"BilledTo"  ;abm*2.6*15 HEAT174501
  1.  W !,"Visit Location"_U_"Patient"_U_"Chart#"_U_"Policy Holder ID"_U_"Serv Cat"_U_"Clinic"_U_"Provider NPI"_U_"Provider"_U_"InsType"_U_"BilledTo"  ;abm*2.6*15 HEAT174501
  1.  W U_"DateOfService"_U_"DatePaid"_U_"Medicaid/SchipPaid"_U_"Bill#"_U_"Payment"_U_"Primary POV"_U_"PRVT"_U_"MCR"_U_"MCD"_U_"CHIP"_U_"NEEDY INDIV"
  1.  W U_"Tribal self-insured"  ;abm*2.6*15 HEAT183289
  1.  W U_"MCD ST"  ;abm*2.6*15 HEAT164125
  1.  W U_"Facility NPI"_U_"Facility TIN"_U_"Record Indicator"  ;abm*2.6*15 HEAT171490 and HEAT161159
  1.  Q:ABMSDT=""
  1.  S ABMVLOC=0
  1.  F  S ABMVLOC=$O(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC)) Q:'ABMVLOC  D
  1.  .;start old abm*2.6*16 HEAT161159
  1.  .;S ABMITYP=""
  1.  .;F  S ABMITYP=$O(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMITYP)) Q:ABMITYP=""  D
  1.  .;.S ABMINS=""
  1.  .;.F  S ABMINS=$O(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMITYP,ABMINS)) Q:ABMINS=""  D
  1.  .;..S ABMPTL=""
  1.  .;..F  S ABMPTL=$O(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMITYP,ABMINS,ABMPTL)) Q:ABMPTL=""  D
  1.  .;...S ABMPTF=""
  1.  .;...F  S ABMPTF=$O(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMITYP,ABMINS,ABMPTL,ABMPTF)) Q:ABMPTF=""  D
  1.  .;....S ABMVDT=0
  1.  .;....F  S ABMVDT=$O(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMITYP,ABMINS,ABMPTL,ABMPTF,ABMVDT)) Q:'ABMVDT  D
  1.  .;.....S ABMP("VDT")=ABMVDT
  1.  .;.....S ABMVDFN=0
  1.  .;.....F  S ABMVDFN=$O(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMITYP,ABMINS,ABMPTL,ABMPTF,ABMVDT,ABMVDFN)) Q:'ABMVDFN  D
  1.  .;......I +$G(^XTMP("ABM-PVP2",$J,"DUPS",ABMVDFN))=1 S ABMDCNT=+$G(ABMDCNT)+1
  1.  .;......S ^XTMP("ABM-PVP2",$J,"DUPS",ABMVDFN)=1
  1.  .;......S ABMPT=$P($G(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMITYP,ABMINS,ABMPTL,ABMPTF,ABMVDT,ABMVDFN)),U,2)
  1.  .;......S ABMTRIEN=$P($G(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMITYP,ABMINS,ABMPTL,ABMPTF,ABMVDT,ABMVDFN)),U,3)
  1.  .;......S IENS=ABMVLOC_","_ABMPT_","
  1.  .;......S ABMHRN=$$GET1^DIQ(9000001.41,IENS,.02)
  1.  .;......W !,$$GET1^DIQ(9999999.06,ABMVLOC,".02","E")
  1.  .;......W U_ABMPTL_", "_ABMPTF  ;pt name
  1.  .;......W U_ABMHRN  ;HRN
  1.  .;......K ABML
  1.  .;......D ELGCHK^ABMM2PV3
  1.  .;......S ABMMIEN=0
  1.  .;......K ABMMCDN
  1.  .;......I ($G(ABML("MCD"))!($G(ABML("CHIP")))) D
  1.  .;.......S ABMMIEN=+$G(ABMP("SAVE"))
  1.  .;.......I ABMMIEN D
  1.  .;........S ABMMCDN=$P($G(^AUPNMCD(ABMMIEN,0)),U,3)
  1.  .;.......I 'ABMMIEN D PRVTCHIP^ABMM2PV3
  1.  .;......I $G(ABMMCDN)'="" W U_ABMMCDN  ;Medicaid # - policy holder ID
  1.  .;......I 'ABMMIEN W U
  1.  .;......W U_$$GET1^DIQ(9000010,ABMVDFN,.07,"E")  ;Cat
  1.  .;......W U_$$GET1^DIQ(9000010,ABMVDFN,.08,"E")  ;clin
  1.  .;......W U_$S(ABMITYP="X":"",1:ABMITYP)  ;itype
  1.  .;......W U_$S(ABMINS="NO BILL":"NOT BILLED",1:$E(ABMINS,1,10))  ;insurer
  1.  .;......W U_$$CDT^ABMDUTL(ABMVDT)  ;vst dt
  1.  .;......W U_$S(+ABMTRIEN:$$SDTO^ABMDUTL(ABMTRIEN),1:"") ;dt pd
  1.  .;......S ABMREC=$G(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMITYP,ABMINS,ABMPTL,ABMPTF,ABMVDT,ABMVDFN))
  1.  .;......D ELGCHK^ABMM2PV3
  1.  .;......W U_$P($G(ABMREC),U,4)
  1.  .;......W U_$P($G(ABMREC),U,5)
  1.  .;......W U_$P($G(ABMREC),U,6)
  1.  .;......W U_$P($G(ABMREC),U,7)
  1.  .;......W U_ABMPI_U_ABMMCR_U_ABMMCD_U_ABMCHIP_U_ABMNI
  1.  .;end old start new HEAT161159
  1.  .S ABMVDT=0
  1.  .F  S ABMVDT=$O(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMVDT)) Q:'ABMVDT  D
  1.  ..S ABMP("VDT")=ABMVDT
  1.  ..S ABMVDFN=0
  1.  ..F  S ABMVDFN=$O(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMVDT,ABMVDFN)) Q:'ABMVDFN  D
  1.  ...I +$G(^XTMP("ABM-PVP2",$J,"DUPS",ABMVDFN))=1 S ABMDCNT=+$G(ABMDCNT)+1
  1.  ...S ^XTMP("ABM-PVP2",$J,"DUPS",ABMVDFN)=1
  1.  ...S ABMPT=$P($G(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMVDT,ABMVDFN)),U,2)
  1.  ...S ABMTRIEN=$P($G(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMVDT,ABMVDFN)),U,3)
  1.  ...S ABMREC=$G(^XTMP("ABM-PVP2",$J,"PT LST",ABMSDT,ABMVLOC,ABMVDT,ABMVDFN))
  1.  ...S ABMPTL=$P(ABMREC,U,10)
  1.  ...S ABMPTF=$P(ABMREC,U,11)
  1.  ...S IENS=ABMVLOC_","_ABMPT_","
  1.  ...S ABMHRN=$$GET1^DIQ(9000001.41,IENS,.02)
  1.  ...W !,$$GET1^DIQ(9999999.06,ABMVLOC,".02","E")
  1.  ...W U_ABMPTL_", "_ABMPTF  ;pt name
  1.  ...W U_ABMHRN  ;HRN
  1.  ...K ABML
  1.  ...D ELGCHK^ABMM2PV3
  1.  ...S ABMMIEN=0
  1.  ...K ABMMCDN
  1.  ...I ($G(ABML("MCD"))!($G(ABML("CHIP")))) D
  1.  ....S ABMMIEN=+$G(ABMP("SAVE"))
  1.  ....I ABMMIEN D
  1.  .....S ABMMCDN=$P($G(^AUPNMCD(ABMMIEN,0)),U,3)
  1.  ....I 'ABMMIEN D PRVTCHIP^ABMM2PV3
  1.  ...I $G(ABMMCDN)'="" W U_ABMMCDN  ;Medicaid # - policy holder ID
  1.  ...I 'ABMMIEN W U
  1.  ...W U_$$GET1^DIQ(9000010,ABMVDFN,.07,"E")  ;Cat
  1.  ...W U_$$GET1^DIQ(9000010,ABMVDFN,.08,"E")  ;clin
  1.  ...W U_$P(ABMREC,U,12)_U_$P(ABMREC,U,13)  ;abm*2.6*15 HEAT174501
  1.  ...;start old abm*2.6*15
  1.  ...;W U_$P(ABMREC,U,8)  ;itype
  1.  ...;W U_$P(ABMREC,U,9)  ;insurer
  1.  ...;end old start new
  1.  ...W U_$S($P(ABMREC,U,8)="X":"",1:$P(ABMREC,U,8))  ;insurer type
  1.  ...W U_$S($P(ABMREC,U,9)="NO BILL":"NOT BILLED",1:$P(ABMREC,U,9))  ;insurer
  1.  ...;end new
  1.  ...;W U_$$CDT^ABMDUTL(ABMVDT)  ;vst dt  ;abm*2.6*15 HEAT188548
  1.  ...W U_$$BDT^ABMDUTL(ABMVDT)  ;vst dt  ;abm*2.6*15 HEAT188548
  1.  ...W U_$S(+ABMTRIEN:$$SDTO^ABMDUTL(ABMTRIEN),1:"") ;dt pd
  1.  ...D ELGCHK^ABMM2PV3
  1.  ...W U_$P($G(ABMREC),U,4)  ;Mcd/schip pd
  1.  ...W U_$P($G(ABMREC),U,5)  ;bill number
  1.  ...W U_$P($G(ABMREC),U,6)  ;pymt
  1.  ...W U_$P($G(ABMREC),U,7)  ;primary pov
  1.  ...;W U_ABMPI_U_ABMMCR_U_ABMMCD_U_ABMCHIP_U_ABMNI  ;abm*2.6*15 HEAT183289
  1.  ...W U_ABMPI_U_ABMMCR_U_ABMMCD_U_ABMCHIP_U_ABMNI_U_$G(ABMTSI)  ;abm*2.6*15 HEAT183289
  1.  ...W U_$G(ABMP("STATE"))  ;abm*2.6*15 HEAT164125
  1.  ...W U_$P(ABMREC,U,15)  ;visit location NPI abm*2.6*15 HEAT171490
  1.  ...W U_$P(ABMREC,U,16)  ;visit location TIN abm*2.6*15 HEAT171490
  1.  ...W U_$P(ABMREC,U,17)  ;record indicator  abm*2.6*15 HEAT161159
  1.  ...;start new abm*2.6*15 HEAT183289
  1.  ...I +$G(ABMFQHC)=1 D
  1.  ....I +$G(ABMICNT)=1&($G(ABMTSI)="Y") D
  1.  .....W "TSI"  ;write TSI if pt has TSI insurer only
  1.  .....I +$P($G(ABMREC),U,6)'=0 W "-PD"  ;if TSI insurer paid
  1.  ....I $G(ABMNI)="Y" W "UNC"  ;write UNC if pt is needy individual
  1.  ...;end new HEAT183289
  1.  ;end new HEAT161159
  1.  I +$G(ABMDCNT)>0 W !!,"Duplicate visits for this period: "_ABMDCNT
  1.  D CLOSE^%ZISH("ABM")
  1.  Q