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

ABMDCCL1.m

Go to the documentation of this file. 
  1. ABMDCCL1 ; IHS/ASDST/DMJ - Cancelled claims listing-80 Width ; 
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**21**;NOV 12, 2009;Build 379
  1.  ;Original;TMD;
  1.  ;
  1.  ;IHS/SD/SDR - v2.5 p10 - IM20215 - HRN not printing on report
  1.  ;
  1.  ;IHS/SD/SDR 2.6*21 - HEAT140244 - Changed to print reason number on detail lines and
  1.  ;  list of reasons with full descriptions at bottom of report.
  1.  ;
  1. PRINT ;EP for printing data
  1.  K ABMRSN  ;abm*2.6*21 IHS/SD/SDR HEAT140244
  1.  S ABM("PG")=0 D HDB
  1.  S (ABM("CNT1"),ABM("CNT2"),ABM("CNT"),ABM("TOT1"),ABM("TOT2"),ABM("TOT"))=0,(ABM("CANC"),ABM("LOC"),ABM("VT"))=""
  1.  S ABM("Z")="TMP(""ABM-CC"","_$J,ABM="^"_ABM("Z")_")" I '$D(@ABM) Q
  1.  F  S ABM=$Q(@ABM) Q:ABM'[ABM("Z")  D  G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) XIT
  1.  .I $Y>(IOSL-5) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)  D SUBHD W " (cont)"
  1.  .S ABM("T")=$P(ABM,"ABM-CC",2),ABM("TXT")=$P($P(ABM("T"),",",3,99),"""",2),ABM("TXT")=+$P(ABM("T"),",",3)_U_ABM("TXT")
  1.  .S ABM("PDFN")=$G(^ABMCCLMS(DUZ(2),$P(ABM("TXT"),U,5),0)) Q:ABM("PDFN")=""
  1.  .I ABM("CANC")'=$P(ABM("TXT"),U) S ABM("CANC")="" D SUB,SUBHD S ABM("LOC")=""
  1.  .I ABM("LOC")'=$P(ABM("TXT"),U,2) D SUB:ABM("LOC")]"" W:(ABM("LOC")'="") ! W !?3,"Visit Location: ",$P(^DIC(4,$P(ABM("PDFN"),U,3),0),U) S ABM("VT")=""
  1.  .S ABM("CANC")=$P(ABM("TXT"),U)
  1.  .S ABM("LOC")=$P(ABM("TXT"),U,2)
  1.  .I ABM("VT")'=$P(ABM("TXT"),U,3) D SUB2:ABM("VT")]"" W:ABM("VT")]"" ! W !?7,$S(ABMY("SORT")="C":"    Clinic: "_$P(^DIC(40.7,$P(ABM("TXT"),U,3),0),U),1:"Visit Type: "_$P(^ABMDVTYP($P(ABM("TXT"),U,3),0),U))
  1.  .S ABM("VT")=$P(ABM("TXT"),U,3)
  1.  .W !
  1.  .W $E($P(^DPT($P(ABM("PDFN"),U),0),U),1,16)  ;pat name
  1.  .W ?18,$P($G(^AUPNPAT($P(ABM("PDFN"),U),41,$P(ABM("PDFN"),U,3),0)),U,2)  ;HRN
  1.  .;W ?25,$E($P(^AUTNINS($P(ABM("PDFN"),U,8),0),U),1,12)  ;ins  ;abm*2.6*21 IHS/SD/SDR HEAT140244
  1.  .W ?25,$E($P(^AUTNINS($P(ABM("PDFN"),U,8),0),U),1,24)  ;ins  ;abm*2.6*21 IHS/SD/SDR HEAT140244
  1.  .;W ?39,$P(ABM("TXT"),U,5)  ;claim number  ;abm*2.6*21 IHS/SD/SDR HEAT140244
  1.  .W ?54,$P(ABM("TXT"),U,5)  ;claim number  ;abm*2.6*21 IHS/SD/SDR HEAT140244
  1.  .;W ?47,$$SDT^ABMDUTL($P($G(^ABMCCLMS(DUZ(2),$P(ABM("TXT"),U,5),0)),U,2))  ;visit date  ;abm*2.6*21 IHS/SD/SDR HEAT140244
  1.  .W ?62,$$SDT^ABMDUTL($P($G(^ABMCCLMS(DUZ(2),$P(ABM("TXT"),U,5),0)),U,2))  ;visit date  ;abm*2.6*21 IHS/SD/SDR HEAT140244
  1.  .;W ?59,$E($P($G(^ABMCCLMR($P($G(^ABMCCLMS(DUZ(2),$P(ABM("TXT"),U,5),1)),U,8),0)),U),1,18)  ;reason  ;abm*2.6*21 IHS/SD/SDR HEAT140244
  1.  .W ?75,$P($G(^ABMCCLMS(DUZ(2),$P(ABM("TXT"),U,5),1)),U,8)  ;reason number  ;abm*2.6*21 IHS/SD/SDR HEAT140244
  1.  .S ABMRSN($P($G(^ABMCCLMS(DUZ(2),$P(ABM("TXT"),U,5),1)),U,8))=+$G(ABMRSN($P($G(^ABMCCLMS(DUZ(2),$P(ABM("TXT"),U,5),1)),U,8)))+1  ;abm*2.6*21 IHS/SD/SDR HEAT140244
  1.  .S ABM("CNT1")=ABM("CNT1")+1,ABM("CNT2")=ABM("CNT2")+1,ABM("CNT")=ABM("CNT")+1,ABM("TOT")=ABM("TOT")+ABM("T")
  1.  .S ABM("TOT1")=ABM("TOT1")+ABM("T"),ABM("TOT2")=ABM("TOT2")+ABM("T")
  1.  D SUB
  1.  ;start new abm*2.6*21 IHS/SD/SDR HEAT140244
  1.  W !!
  1.  W ?3,"Reasons on report: "
  1.  W !?6,"Rsn",?10,"Description",?57,"#times on report"
  1.  S ABMR=0
  1.  F  S ABMR=$O(ABMRSN(ABMR)) Q:'ABMR  D
  1.  .W !?6,ABMR,?10,$P($G(^ABMCCLMR(ABMR,0)),U),?57,+$G(ABMRSN(ABMR))
  1.  K ABMRSN
  1.  ;end new abm*2.6*21 IHS/SD/SDR HEAT140244
  1.  Q
  1.  ;
  1. HD D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1. HDB S ABM("PG")=ABM("PG")+1,ABM("I")="" D WHD^ABMDRHD
  1.  ;start old abm*2.6*21 IHS/SD/SDR HEAT140244
  1.  ;W !?25,"Active",?39,"Claim",?50,"Visit"
  1.  ;W !?2,"Patient",?18,"HRN",?25,"Insurer",?39,"Number",?50,"Date",?63,"Reason"
  1.  ;end old start new abm*2.6*21 IHS/SD/SDR HEAT140244
  1.  W !?25,"Active",?54,"Claim",?62,"Visit"
  1.  W !?2,"Patient",?18,"HRN",?25,"Insurer",?54,"Number",?62,"Date",?75,"Rsn"
  1.  ;end new abm*2.6*21 IHS/SD/SDR HEAT140244
  1.  W !,"-------------------------------------------------------------------------------"
  1.  Q
  1.  ;
  1. SUBHD ;
  1.  W !!,"Cancelling Official: ",$P(^VA(200,$P($G(^ABMCCLMS(DUZ(2),$P(ABM("TXT"),U,5),1)),U,4),0),U)
  1.  Q
  1.  ;
  1. SUB2 Q:'ABM("CNT2")
  1.  W !?27,"------"
  1.  W !?16,"Subcount:",?27,ABM("CNT2")
  1.  S ABM("CNT2")=0,ABM("TOT2")=0,ABM("I")=""
  1.  Q
  1.  ;
  1. SUB Q:'ABM("CNT1")  D SUB2:ABM("CNT1")'=ABM("CNT2")
  1.  W !?27,"------"
  1.  W !?19,"Count:",?27,ABM("CNT1")
  1.  S ABM("CNT1")=0,ABM("TOT1")=0,ABM("CNT2")=0,ABM("TOT2")=0,ABM("I")=""
  1.  Q
  1. XIT ;EXIT POINT
  1.  Q