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

IBCOMN1.m

Go to the documentation of this file. 
  1. IBCOMN1 ;ALB/CMS - PATIENTS NO COVERAGE VERIFIED REPORT (CON'T);10-09-98
  1.  ;;2.0;INTEGRATED BILLING;**103,528,602,743,752**;21-MAR-94;Build 20
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  Q
  1.  ;
  1. BEG ; Entry to run Patients w/no Coverage Verification Report
  1.  ; Input variables:
  1.  ; IBAIB - Required.    How to sort
  1.  ;         1= Patient Name Range      2= Terminal Digit Range
  1.  ;
  1.  ; IBRF  - Required.  Name or Terminal Digit Range Start value
  1.  ; IBRL  - Required.  Name or Terminal Digit Range Go to value
  1.  ; IBBDT - Required.  Begining Verification Date Range
  1.  ; IBEDT - Required.  Ending Verification Date Range
  1.  ; IBOUT - Required.  Output format
  1.  ;         "R"= report format        "E"= Excel format
  1.  ;
  1.  N DFN,IBDT,IBGP,IBI,IBQUIT,IBPAGE,IBTMP,IBTD,IBX,VA,VADM,VAERR,X,Y
  1.  N IBVANM S IBVANM=""  ;IB*752/DTG - new variable for case insensitive
  1.  ;
  1.  I "^R^E^"'[(U_$G(IBOUT)_U) S IBOUT="R"
  1.  K ^TMP("IBCOMN",$J) S IBPAGE=0,IBQUIT=0
  1.  S IBDT=IBBDT F  S IBDT=$O(^IBA(354,"AVDT",IBDT)) Q:('IBDT)!(IBDT>IBEDT)  D
  1.  .S DFN=0 F  S DFN=$O(^IBA(354,"AVDT",IBDT,DFN)) Q:'DFN  D
  1.  ..K VA,VADM,VAERR,VAPA
  1.  ..D DEM^VADPT,ADD^VADPT
  1.  ..;
  1.  ..;  I Pt. name out of range quit
  1.  ..S VADM(1)=$P($G(VADM(1)),U,1) I VADM(1)="" Q
  1.  ..;IB*752/DTG - case insensitive check
  1.  ..S IBVANM=$$UP^XLFSTR(VADM(1))
  1.  ..;I IBAIB=1,VADM(1)]IBRL Q
  1.  ..;I IBAIB=1,IBRF]VADM(1) Q
  1.  ..I IBAIB=1,$E(IBVANM,1,$L(IBRLU))]IBRLU Q
  1.  ..I IBAIB=1,IBRFU]$E(IBVANM,1,$L(IBRFU)) Q
  1.  ..;
  1.  ..;  I Terminal Digit out of range quit
  1.  ..I IBAIB=2 S IBTD=$$TERMDG^IBCONS2(DFN) I (+IBTD>IBRL)!(IBRF>+IBTD) Q
  1.  ..;
  1.  ..; Fix subscript error if terminal digit is null
  1.  ..I IBAIB=2,IBTD="" S IBTD=" "
  1.  ..;
  1.  ..;   set data line, set global * if deceased
  1.  ..;S IBTMP=PT NAME^SSN^AGE^DOB^HOME PHONE^VERIFICATION NO COV
  1.  ..S IBTMP=$S($G(VADM(6)):"*",1:"")_VADM(1)_U_$P($P(VADM(2),U,2),"-",3)_U_+VADM(4)_U_$$FMTE^XLFDT(VADM(3),"5ZD")_U_$P(VAPA(8),U,1)_U_$$FMTE^XLFDT(IBDT,"5ZD")
  1.  ..S ^TMP("IBCOMN",$J,$S(IBAIB=2:IBTD,1:VADM(1)),DFN)=IBTMP
  1.  ..;
  1.  ;
  1.  I '$D(^TMP("IBCOMN",$J)) D HD W !!,"** NO RECORDS FOUND **" D EOR,ASK G QUEQ
  1.  D HD,WRT
  1.  ;
  1. QUEQ ; Exit clean-UP
  1.  W ! D ^%ZISC K IBTMP,IBAIB,IBOUT,IBRF,IBRL,VA,VAERR,VADM,VAPA,^TMP("IBCOMN",$J)
  1.  Q
  1.  ;
  1. HD ;Write Heading
  1.  S IBPAGE=IBPAGE+1
  1.  ; IB*602/HN ; Add report headers to Excel Spreadsheets
  1.  I IBOUT="E" D  W:($E(IOST,1,2)["C-") ! W "Patient Name^SSN^Age^DOB^Phone^Verified" Q
  1.  .W !,"Patients w/No Coverage Verification Date Report     "_$$FMTE^XLFDT($$NOW^XLFDT,"Z")
  1.  .W !,"Verification Date Range: "_$$FMTE^XLFDT(IBBDT,"Z")_" to "_$$FMTE^XLFDT(IBEDT,"Z")
  1.  .W !," Filtered by: "_$S(IBAIB=1:"Patient Name",1:"Terminal Digit")_" Range: "_$S(IBRF="":"FIRST",1:IBRF)_" to "_$S(IBRL="zzzzzz":"LAST",1:IBRL)  ;IB*752/DTG - sort to filter
  1.  .W !,"(* - Patient Deceased)"
  1.  ; IB*602/HN end
  1.  W @IOF,!,"Patients w/No Coverage Verification Date Report",?50,$$FMTE^XLFDT($$NOW^XLFDT,"Z"),?70," Page ",IBPAGE
  1.  W !,?5,"Verification Date Range: "_$$FMTE^XLFDT(IBBDT,"Z")_" to "_$$FMTE^XLFDT(IBEDT,"Z")
  1.  ;IB*743/TAZ - Modified Check of IBRF
  1.  ;W !,?5,"  Sorted by: "_$S(IBAIB=1:"Patient Name",1:"Terminal Digit")_"  Range: "_$S(IBRF="A":"FIRST",1:IBRF)_" to "_$S(IBRL="zzzzzz":"LAST",1:IBRL)
  1.  W !,?5,"  Filtered by: "_$S(IBAIB=1:"Patient Name",1:"Terminal Digit")_"  Range: "_$S(IBRF="":"FIRST",1:IBRF)_" to "_$S(IBRL="zzzzzz":"LAST",1:IBRL)  ;IB*752/DTG - sort to filter
  1.  W !,?20,"(*  - Patient Deceased)"
  1.  W !,"Patient Name",?31,"SSN",?38,"Age",?43,"DOB",?55,"Phone",?70,"Verified"
  1.  W ! F IBX=1:1:79 W "="
  1.  Q
  1.  ;
  1. WRT ;Write data lines
  1.  N IBA,IBDFN,IBPT,X,Y S IBQUIT=0
  1.  S IBA="" F  S IBA=$O(^TMP("IBCOMN",$J,IBA)) Q:(IBA="")!(IBQUIT=1)  D
  1.  .S IBDFN=0 F  S IBDFN=$O(^TMP("IBCOMN",$J,IBA,IBDFN)) Q:('IBDFN)!(IBQUIT=1)  D
  1.  ..S IBPT=$G(^TMP("IBCOMN",$J,IBA,IBDFN))
  1.  ..;
  1.  ..I ($Y+5)>IOSL,(IBOUT="R") D  I IBQUIT=1 Q
  1.  ...D ASK I IBQUIT=1 Q
  1.  ...D HD
  1.  ..;
  1.  ..; Excel Output
  1.  ..I IBOUT="E" W !,$P(IBPT,U,1)_U_$E($P(IBPT,U,1),1,1)_$P(IBPT,U,2)_U_$P(IBPT,U,3,6) Q
  1.  ..; Report Output
  1.  ..W !,$E($P(IBPT,U,1),1,30),?31,$E($P(IBPT,U,1),1,1),$P(IBPT,U,2),?38,$J($P(IBPT,U,3),3),?43,$P(IBPT,U,4),?55,$E($P(IBPT,U,5),1,15),?70,$P(IBPT,U,6)
  1.  ..;
  1.  ;I 'IBQUIT D ASK
  1.  I 'IBQUIT D EOR,ASK  ;IB*752/DTG - EOR message
  1.  Q
  1.  ;
  1. ASK ; Ask to Continue with display
  1.  I $E(IOST,1,2)'["C-" Q
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="E" D ^DIR
  1.  I ($D(DIRUT))!($D(DUOUT)) S IBQUIT=1
  1.  Q
  1.  ;
  1. EOR ;  End of report  ;IB*752/DTG
  1.  W !,"   ** END OF REPORT **",!
  1.  Q