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

BMCFPRN1.m

Go to the documentation of this file. 
  1. BMCFPRN1 ;IHS/OIT/FCJ - PRINT REFERRAL FORM PART 2 ; 04 May 2018  4:45 PM
  1.  ;;4.0;REFERRED CARE INFO SYSTEM;**1,3,13**;JAN 09, 2006;Build 101
  1.  ;;IHS/ITSC/FCJ SPLIT RTN FROM BMCFPRN, MULT CHGS TO CALL BMCFPRN
  1.  ;4.0*1 5.17.06 IHS/OIT/FCJ ADDED PRINTING OF ELIG DATES
  1.  ;     FOR MEDICARE AND MEDICAID
  1.  ;4.0*3 11.29.06 IHS/OIT/FCJ NOT EXITING LOOP W/MUL INS W/SAME #
  1.  ;4.0*13 3.30.18 IHS.OIT.FCJ ADDED NEW MBI FOR MEDICARE AND RRR
  1.  ;
  1. OTHPAY ;ENTRY POINT
  1.  ;Third Party Coverage as of Best Avail Beg Dt or Today
  1.  S Y=$$ANYINS^BMCRLU($P(BMCR0,U,3),$S($$AVDOS^BMCRLU(BMCREF)]"":$$AVDOS^BMCRLU(BMCREF,"I"),1:DT))
  1.  ;
  1. BEGDT ;Write Msg based on existence of Best Avail Beg & No Third Party
  1.  I 'Y D  Q
  1.  .S BMCDT=$$AVDOS^BMCRLU(BMCREF)
  1.  .I BMCDT'="" S X="Records indicate patient has no third party coverage for this Service Date.",N=1,T=0,C=0 D W^BMCFPRN Q
  1.  .E  S X="Our records indicate that the patient has no third party coverage as of today.",N=1,T=0,C=0 D W^BMCFPRN Q:BMCQUIT
  1.  S X="Our records, as of "_$$FMTE^XLFDT(DT,"5D")_" indicate that this patient has the following",C=0,T=0,N=1 D W^BMCFPRN Q:BMCQUIT
  1.  S X="third party coverage:",C=0,T=0,N=1 D W^BMCFPRN Q:BMCQUIT
  1.  ;
  1. THIRD ;display third party coverage
  1.  ;4.0*13 3.30.18 IHS.OIT.FCJ CHG NEXT SECTION TO PRT NEW MBI
  1. MCR ;MEDICARE
  1.  S BMCI=1
  1.  G:'$D(^AUPNMCR(BMCDFN)) MCD
  1.  S BMCNUM="",BMCMBI="",BMCN=0
  1.  S BMCMBI=$$GETMBI^AUPNMBI(BMCDFN,DT,0)
  1.  I BMCMBI<1 S BMCMBI=$P($G(^AUPNMCR(BMCDFN,0)),U,3) I $P(^AUPNMCR(BMCDFN,0),U,4)'="" S BMCMBI=BMCMBI_$G(^AUTTMCS($P(^AUPNMCR(BMCDFN,0),U,4),0))
  1.  ;test for elig dates
  1.  G:'$D(^AUPNMCR(BMCDFN,11)) MCD
  1.  S BMCE=0,J=0 F  S J=$O(^AUPNMCR(BMCDFN,11,J)) Q:J'=+J  D
  1.  .Q:J>DT
  1.  .I $P(^AUPNMCR(BMCDFN,11,J,0),U,2)]"",$P(^(0),U,2)<DT Q
  1.  .S BMCE=1,BMCE(J)=^AUPNMCR(BMCDFN,11,J,0)
  1.  G:'BMCE MCD
  1.  ;TEST FOR COV TYPE "D" BEFORE WRITING MEDICARE NO.
  1.  I $G(BMCE) S J=0 F  S J=$O(BMCE(J)) Q:J'?1N.N  D
  1.  .S BMCEBDT=$P(BMCE(J),U),BMCEEDT=$P(BMCE(J),U,2),BMCECOV=$P(BMCE(J),U,3)
  1.  .S BMCNUM=$S(BMCECOV="D":$P(BMCE(J),U,6),1:BMCMBI)
  1.  .;PRINT ELIG NUMBER
  1.  .I BMCNUM="" S BMCNUM="NO POLICY #"
  1.  .S C=0,N=1,T=10,BMCI=BMCI+1,X="PATIENT HAS MEDICARE: - "_BMCNUM,N=1,C=0,T=10 D W^BMCFPRN Q:BMCQUIT
  1.  .S:BMCEEDT="" BMCEEDT="OPEN"
  1.  .S C=0,N=1,T=10,X="ELIG DATES: "_$$FMTE^XLFDT(BMCEBDT,"5D")_" TO "
  1.  .S X=X_$$FMTE^XLFDT(BMCEEDT,"5D")_"   COVERAGE: "_BMCECOV D W^BMCFPRN Q:BMCQUIT
  1.  K BMCE,BMCEB,BMCEEDT,BMCEBDT,BMCECOV
  1. MCD I $$MCD^AUPNPAT(BMCDFN,DT) D
  1.  .S BMCN=0 F  S BMCN=$O(^AUPNMCD("B",BMCDFN,BMCN)) Q:BMCN'?1N.N  D
  1.  ..Q:'$D(^AUPNMCD(BMCN,11))
  1.  ..;4.0*3 11.29.06 IHS/OIT/FCJ NOT EXITING PROP W/MUL INS W/SAME #
  1.  ..;S BMCE=0,J=0 F  S J=$O(^AUPNMCD(BMCN,11,J)) Q:J'=+J  D
  1.  ..S BMCE=0,J=0 F  S J=$O(^AUPNMCD(BMCN,11,J)) Q:J'?1N.N  D
  1.  ...Q:J>DT
  1.  ...I $P(^AUPNMCD(BMCN,11,J,0),U,2)]"",$P(^(0),U,2)<DT Q
  1.  ...S BMCE=1,BMCE(J)=^AUPNMCD(BMCN,11,J,0)
  1.  ..Q:'BMCE
  1.  ..;S BMCNI=$P(^AUPNMCD(BMCN,0),U,10) ;4.0*1 2.9.06 IHS.OIT.FCJ
  1.  ..S BMCNI=$P(^AUPNMCD(BMCN,0),U,10),BMCX="" ;4.0*1 2.9.06 IHS.OIT.FCJ
  1.  ..I BMCNI]"" S BMCX=$P($G(^AUTNINS(BMCNI,0)),U)
  1.  ..S:BMCX="" BMCX="UNKNOWN"
  1.  ..S BMCNUM="",BMCNUM=$P($G(^AUPNMCD(BMCN,0)),U,3)
  1.  ..I BMCNUM="" S BMCNUM="NO POLICY #"
  1.  ..S BMCX=BMCX_" - "_BMCNUM
  1.  ..S C=0,N=1,T=10,BMCI=BMCI+1,X="PATIENT HAS MEDICAID-PLAN NAME:  "_BMCX D W^BMCFPRN Q:BMCQUIT
  1.  ..I $G(BMCE) S BMCEBDT="" F  S BMCEBDT=$O(BMCE(BMCEBDT)) Q:BMCEBDT'?1N.N  D
  1.  ...S BMCEEDT=$P(^AUPNMCD(BMCN,11,BMCEBDT,0),U,2),BMCECOV=$P(^(0),U,3)
  1.  ...S:BMCEEDT="" BMCEEDT="OPEN"
  1.  ...S C=0,N=1,T=10,X="ELIG DATES: "_$$FMTE^XLFDT(BMCEBDT,"5D")_" TO "
  1.  ...S X=X_$$FMTE^XLFDT(BMCEEDT,"5D")_"   COVERAGE: "_BMCECOV D W^BMCFPRN
  1.  ...K BMCE(BMCEBDT)
  1.  ..;4.0*1 5.17.06 IHS.OIT.FCJ END OF CHANGES
  1.  K BMCE,BMCEEDT,BMCEBDT,BMCECOV
  1.  ;
  1. PVTINS ;Private Insurance Companies
  1.  S (P,DFN)=BMCDFN,D=DT,BMCFLAG=1,BMCPCNT=0 K BMCPRNM D PI^BMCRLU1
  1.  K P,D,BMCFLAG,BMCPCNT
  1.  I '$D(BMCPRNM) W !,?10,"NO PRIVATE INSURANCE COVERAGE"
  1.  I $D(BMCPRNM) D
  1.  .W !,?10,"PRIVATE INSURER(S): "
  1.  .S BMCX=0
  1.  .F  S BMCX=$O(BMCPRNM(BMCX)) Q:BMCX'=+BMCX  W ?32,BMCPRNM(BMCX),!
  1.  ;
  1. RR ;RAILROAD INS.
  1.  ;4.0*13 3.30.18 IHS.OIT.FCJ CHG NEXT SECTION TO PRT NEW MBI
  1.  S BMCI=1,BMCMBI=""
  1.  Q:'$D(^AUPNRRE(BMCDFN))
  1.  ;test for elig dates
  1.  Q:'$D(^AUPNRRE(BMCDFN,11))
  1.  S BMCE=0,J=0 F  S J=$O(^AUPNRRE(BMCDFN,11,J)) Q:J'=+J  D
  1.  .Q:J>DT
  1.  .I $P(^AUPNRRE(BMCDFN,11,J,0),U,2)]"",$P(^(0),U,2)<DT Q
  1.  .S BMCE=1,BMCE(J)=^AUPNRRE(BMCDFN,11,J,0)
  1.  Q:'BMCE
  1.  S BMCMBI=$$GETMBI^AUPNMBI(BMCDFN,DT,0)
  1.  I +BMCMBI<1 D
  1.  .S BMCMBI="" I $P($G(^AUPNRRE(BMCDFN,0)),U,3)'="" S BMCMBI=$P($G(^AUTTRRP($P(^AUPNRRE(BMCDFN,0),U,3),0)),U)
  1.  .S BMCMBI=BMCMBI_$P($G(^AUPNRRE(BMCDFN,0)),U,4)
  1.  S BMCI=BMCI+1,X="RAILROAD:  - "_BMCMBI
  1.  S N=1,C=0,T=10 D W^BMCFPRN Q:BMCQUIT
  1.  I $G(BMCE) S J=0 F  S J=$O(BMCE(J)) Q:J'?1N.N  D
  1.  .S BMCEBDT=$P(BMCE(J),U),BMCEEDT=$P(BMCE(J),U,2),BMCECOV=$P(BMCE(J),U,3)
  1.  .S C=0,N=1,T=10,X="ELIG DATES: "_$$FMTE^XLFDT(BMCEBDT,"5D")_" TO "
  1.  .S X=X_$$FMTE^XLFDT(BMCEEDT,"5D")_"   COVERAGE: "_BMCECOV D W^BMCFPRN
  1.  ;I $$RAIL^BMCRLU(BMCDFN,DT) S BMCI=BMCI+1,X="RAILROAD:  - "_$P($G(^AUTTRRP($P($G(^AUPNRRE(BMCDFN,0)),U,3),0)),U,1)_$P($G(^AUPNRRE(BMCDFN,0)),U,4),N=1,C=0,T=10 D W^BMCFPRN Q:BMCQUIT
  1.  K BMCMBI
  1.  Q