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