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

ACHSRPI.m

Go to the documentation of this file. 
  1. ACHSRPI ; IHS/ITSC/PMF - SET PRIVATE INS/RATE QUOT VARS FOR UNIVERSAL FORM  [ 10/16/2001   8:16 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
  1.  ;
  1. PVT ;
  1.  Q:DFN=""
  1.  S (DA,N)=0
  1.  G MCR:'$D(^AUPNPRVT(DFN,11))
  1. PVT1 ;
  1.  F  S DA=$O(^AUPNPRVT(DFN,11,DA)) G:'DA MCR D
  1.  . S N=N+1,ACHSINS=$G(^AUPNPRVT(DFN,11,DA,0))
  1.  . S I(N,1)=$P(ACHSINS,U,4),I(N,2)=$P(ACHSINS,U),I(N,5)=$P(ACHSINS,U,2),I(N,6)=$P(ACHSINS,U,3),I(N,7)=$P(ACHSINS,U,6),I(N,8)=$P(ACHSINS,U,7)
  1.  . S ACHSINS1=$P($G(^AUTNINS(I(N,2),0)),U),I(N,2)=$P(ACHSINS1,U),I(N,3)=$P(ACHSINS1,U,2)
  1.  . I $P(ACHSINS1,U,4),$D(^DIC(5,$P(ACHSINS1,U,4),0)) S X=$P(^(0),U,2),I(N,4)=$P(ACHSINS1,U,3)_", "_X_"  "_$P(ACHSINS1,U,5)
  1.  . I I(N,6)'="" S I(N,6)=$P($G(^AUTTPIC(I(N,6),0)),U)
  1.  . ;
  1.  . ;IF THIS IS NOT PRIMARY INS. AND POLICY END DATE IS NOT LESS THAN
  1.  . ;AUTHORIZED FROM DATE OR POLICY END DATE IS NULL SET THIS AS
  1.  . ;PRIMARY INSURANCE
  1.  . I (ACHSIPRM="N"),((I(N,8)'<ACHSFDT)!(I(N,8)="")) S ACHSIPRM="Y",I("P",N)="" Q
  1.  . S I(N,7)=$$FMTE^XLFDT(I(N,7))
  1.  . S I(N,8)=$$FMTE^XLFDT(I(N,8))
  1.  . S I("B",N)=$E(I(N,2),1,(38-$L(I(N,5))))_" "_I(N,5)_"^EFF:"_I(N,7)_" "_I(N,8)
  1.  . K I(N)
  1.  .Q
  1. MCR ;
  1.  S N=N+1
  1.  G MCD:'$D(^AUPNMCR("B",DFN))
  1.  S ACHSMR=N
  1.  S ACHSMDFN=0,ACHSMDFN=$O(^AUPNMCR("B",DFN,ACHSMDFN)),ACHSINS=$G(^AUPNMCR(ACHSMDFN,0))
  1.  G:$P(ACHSINS,U,3)="" MCD   ;SKIP IF MEDICARE # NULL
  1.  S I(N,5)=$P(ACHSINS,U,3)   ;
  1.  ;IF SUFFIX NOT NULL ADD TO MEDICARE # 
  1.  S:$P(ACHSINS,U,4)'="" I(N,5)=I(N,5)_$P($G(^AUTTMCS($P(ACHSINS,U,4),0)),U)
  1.  ;GET NAME OF INSURED
  1.  S I(N,1)=$S($D(^AUPNMCR(ACHSMDFN,21)):$P(^(21),U),'$D(^(21)):$P($G(^DPT(DFN,0)),U))
  1.  S ACHSGL="^AUPNMCR"
  1.  D SET
  1. MCD ;
  1.  G RRE:'$D(^AUPNMCD("B",DFN))
  1.  S ACHSMDFN=0,ACHSMR=N,ACHSMDFN=$O(^AUPNMCD("B",DFN,ACHSMDFN))
  1.  G:ACHSMDFN="" RRE
  1.  S ACHSINS=$G(^AUPNMCD(ACHSMDFN,0))
  1.  S I(N,5)=$P(ACHSINS,U,3)  ;MEDICAID #
  1.  S I(N,1)=$P(ACHSINS,U,5)  ;NAME OF INSURED
  1.  S ACHSGL="^AUPNMCD"
  1.  D SET     ;
  1. RRE ;
  1.  G END:'$D(^AUPNRRE("B",DFN))
  1.  S ACHSMDFN=0,ACHSMR=N,ACHSMDFN=$O(^AUPNRRE("B",DFN,ACHSMDFN))
  1.  G:ACHSMDFN="" END
  1.  S ACHSINS=$G(^AUPNRRE(ACHSMDFN,0)),I(N,5)=$P(ACHSINS,U,3),I(N,1)=$P(ACHSINS,U,5),ACHSGL="^AUPNRRE"
  1.  D SET
  1. END ;
  1.  K ACHSMDFN,DA,ACHSGL,ACHSINS,ACHSINS1,ACHSMR
  1.  Q
  1.  ;
  1.  ;FOR EACH MEDICARE, MEDICAID AND RAILROAD INSURANCE ENTRY
  1. SET ;
  1.  S:$P(ACHSINS,U,2)'="" I(N,2)=$P($G(^AUTNINS($P(ACHSINS,U,2),0)),U)
  1.  S DA=0
  1.  ;FOR EACH MEDICARE, MEDICAID OR RAILROAD INSURER ENTRY
  1.  F  S DA=$O(@ACHSGL@(ACHSMDFN,11,DA)) Q:'DA  D  S N=N+1
  1.  . ;12/27/00  PMF  changing to remove naked ref
  1.  . S COVTEMP=@ACHSGL@(ACHSMDFN,11,DA,0)
  1.  . S I(N,6)=$P(COVTEMP,U,3)  ;COVERAGE TYPE
  1.  . S I(N,7)=$P(COVTEMP,U)         ;POLICY FROM DATE
  1.  . S I(N,8)=$P(COVTEMP,U,2)       ;POLICY TO DATE
  1.  . K COVTEMP
  1.  . ;
  1.  . I ACHSIPRM="N" S ACHSIPRM="Y",I("P",N)="" Q
  1.  . S I(N,7)=$$FMTE^XLFDT(I(N,7))
  1.  . S I(N,8)=$$FMTE^XLFDT(I(N,8))
  1.  . ;
  1.  . S I("B",N)=$E(I(ACHSMR,2),1,(37-$L(I(ACHSMR,5))-$L(I(N,6))))_" "_I(ACHSMR,5)_" "_I(N,6)_"^EFF:"_I(N,7)_" "_I(N,8)
  1.  . K:N'=ACHSMR I(N)
  1.  .Q
  1.  Q
  1.  ;