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