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

APSQPINS.m

Go to the documentation of this file. 
  1. APSQPINS ;IHS/ITSC/ENM - FIND ALL PRIVATE INSURANCE [ 08/29/2003  3:26 PM ];30-Aug-2006 10:40;SM
  1.  ;;7.0;IHS PHARMACY MODIFICATIONS;**1005**;11/11/2002
  1.  ; Modified - IHS/CIA/PLS - 03/11/04
  1.  ;            IHS/MSC/PLS - 08/30/06 - updated MCR API
  1.  Q
  1. PIN(P,D,F,CNT) ;EP - return private insurer name for patient P on date D in form F
  1.  I '$G(P) Q 0
  1.  I '$G(D) Q 0
  1.  N I,Y,Z
  1.  S Z=""
  1.  S F=$G(F)
  1.  S Y="",U="^"
  1.  I '$D(^DPT(P,0)) G PINX
  1.  I $P(^DPT(P,0),U,19) G PINX
  1.  I '$D(^AUPNPAT(P,0)) G PINX
  1.  I '$D(^AUPNPRVT(P,11)) G PINX
  1.  I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G PINX
  1.  S I=0
  1.  S CNT("A")=0
  1.  F  S I=$O(^AUPNPRVT(P,11,I)) Q:I'=+I  D
  1.  . Q:$P(^AUPNPRVT(P,11,I,0),U)=""
  1.  . S Y=$P(^AUPNPRVT(P,11,I,0),U)
  1.  . Q:$P(^AUTNINS(Y,0),U)["AHCCCS"
  1.  . Q:$P(^AUPNPRVT(P,11,I,0),U,6)>D
  1.  . N GP,DE  ;GRACE PERIOD FOR THIS INSURER
  1.  . S GP=$$GP(Y)
  1.  . S DE=$$FMADD^XLFDT(D,-GP)  ;TAKE INTO ACCOUNT GRACE PERIOD
  1.  . Q:($P(^AUPNPRVT(P,11,I,0),U,7)]"")&($P(^(0),U,7)<DE)
  1.  . S Y=$S(F="E":$P(^AUTNINS(Y,0),U),1:Y)
  1.  . S Z=$G(Z)_", "_Y_"*"_GP_"*"
  1.  . S CNT("A")=CNT("A")+1
  1.  . Q
  1.  S Z=$E(Z,3,999)  ;GET RID OF FIRST LETTER ','
  1. PINX ;
  1.  Q Z
  1.  ;
  1. MCR(P,D) ;EP - patient P medicare eligible on date D. IHS/OKCAO/POC 11/23/2001
  1.  ; I = IEN in ^AUPNMCR multiple.
  1.  ;Returns the Medicare Insurer IEN^Plan IEN
  1.  Q:'$G(P) 0
  1.  Q:'$G(D) 0
  1.  N I,Y
  1.  S Y=0
  1.  I '$D(^DPT(P,0)) G MCRX
  1.  I $P(^DPT(P,0),U,19) G MCRX
  1.  I '$D(^AUPNPAT(P,0)) G MCRX
  1.  I '$D(^AUPNMCR(P,11)) G MCRX
  1.  I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G MCRX
  1.  S I=0
  1.  F  S I=$O(^AUPNMCR(P,11,I)) Q:I'=+I  D
  1.  .Q:$P(^AUPNMCR(P,11,I,0),U)>D
  1.  .N GP,DE  ;GRACE PERIOD,DATE ENDING
  1.  .S GP=$$GP($P(^AUPNMCR(P,0),U,2))
  1.  .S DE=$$FMADD^XLFDT(D,-GP)
  1.  .I $P(^AUPNMCR(P,11,I,0),U,2)]"",$P(^(0),U,2)<DE Q
  1.  .S Y=$P(^AUPNMCR(P,0),U,2)_U_$P(^AUPNMCR(P,11,I,0),U,4)  ;IHS/MSC/PLS - 08/30/06 - Added Plan IEN
  1. MCRX Q Y
  1.  ;
  1. MCD(P,D) ;EP - patient P medicaid eligible on date D. IHS/OKCAO/POC 11/23/2001
  1.  ;RETURNS THE PATIENT IEN IN THE INSURER FILE IHS/OKCAO/POC
  1.  ; I = IEN.
  1.  ; J = Node 11 IEN in ^AUPNMCD.
  1.  I '$G(P) Q 0
  1.  I '$G(D) Q 0
  1.  N I,J,Y,INSURER,STATE,NODE0
  1.  S Y=0,U="^"
  1.  I '$D(^DPT(P,0)) G MCDX
  1.  I $P(^DPT(P,0),U,19) G MCDX
  1.  I '$D(^AUPNPAT(P,0)) G MCDX
  1.  I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G MCDX
  1.  S I=0 F  S I=$O(^AUPNMCD("B",P,I)) Q:I'=+I  D
  1.  .Q:'$D(^AUPNMCD(I,11))
  1.  .S J=0 F  S J=$O(^AUPNMCD(I,11,J)) Q:J'=+J  D
  1.  ..Q:J>D
  1.  ..N GP,DE,NODE0,INSURER,INSURERR  ;GRACE PERIOD ENDING DATE,NODE 0 ,INSURER FILE,POINTER TO STATE MEDICAID INSURER
  1.  ..S NODE0=$G(^AUPNMCD(I,0))
  1.  ..S INSURER=$P(NODE0,U,2),STATE=$P(NODE0,U,4)
  1.  ..I 'INSURER!('STATE) Q
  1.  ..S INSURERR=$P($G(^AUTNINS(INSURER,13,STATE,0)),U,2)
  1.  ..S GP=$$GP(INSURERR)
  1.  ..S DE=$$FMADD^XLFDT(DT,-GP)
  1.  ..  ;I $P(^AUPNMCD(I,11,J,0),U,2)]"",$P(^(0),U,2)<D Q
  1.  ..I $P(^AUPNMCD(I,11,J,0),U,2)]"",$P(^(0),U,2)<DE Q
  1.  ..S Y=INSURERR
  1.  ..Q
  1.  .Q
  1.  ;
  1. MCDX ;
  1.  Q Y
  1.  ;
  1.  ;
  1. GP(INS) ;EP - GRACE PERIOD FOR AN INSURER-LOOK AT DEFAULT AND INDIVIDUAL INSURER IHS/OKCAO/POC 11/23/2001
  1.  N DEFINS,SPECINS,Y
  1.  S Y=0
  1.  I '+INS Q Y
  1.  S DEFINS=$$GET1^DIQ(9002313.99,"1,",951)
  1.  S Y=+DEFINS
  1.  S SPECINS=$$GET1^DIQ(9002313.4,INS_",",100.08)
  1.  S:+SPECINS Y=+SPECINS
  1.  Q Y