BDWIN1 ; IHS/CMI/LAB - BDW Create Insurance Array for GIS DW1 Export ;
;;1.0;IHS DATA WAREHOUSE;**5**;JAN 23, 2006;Build 32
;
;
;
;
;
;this routine will populate the IN1 segment of the HL IHS DW1 A31 message
;
MAIN ;-- this is the main routine driver
K INDA("IN1")
D MCD,MCR,RRE,PI
Q
;
MCD ;-- get medicaid data for the message
S BDWCNT=0
Q:'$O(^AUPNMCD("B",DFN,0))
S BDWDA=0 F S BDWDA=$O(^AUPNMCD("B",DFN,BDWDA)) Q:'BDWDA D
. S BDWDATA=$G(^AUPNMCD(BDWDA,0))
. S BDWMDA=0 F S BDWMDA=$O(^AUPNMCD(BDWDA,11,BDWMDA)) Q:'BDWMDA D
.. S BDWMDATA=$G(^AUPNMCD(BDWDA,11,BDWMDA,0))
.. S BDWCNT=BDWCNT+1
.. S INDA("IN1",BDWCNT)=""
.. S INA("BDW1IN13",BDWCNT)=$S($P(BDWDATA,U,2):$P(^AUTNINS($P(BDWDATA,U,2),0),U,7),1:"")
.. S INA("BDW1IN147",BDWCNT)=$P(BDWMDATA,U,3)
.. S INA("BDW1IN112",BDWCNT)=$$DATE^INHUT($P(BDWMDATA,U))
.. S INA("BDW1IN115",BDWCNT)=$S($P(BDWDATA,U,4):$P($G(^DIC(5,$P(BDWDATA,U,4),0)),U,3),1:"")_U_$$GET1^DIQ(9000004,BDWDA,.11) ;$P($G(^AUPNMCD(BDWDA,0)),U,10) ;IHS/CMI/LAB - changed state piece 2 to piece 3
.. S INA("BDW1IN14",BDWCNT)="MCD"_U_$$GET1^DIQ(9000004,BDWDA,.02)
.. S INA("BDW1IN113",BDWCNT)=$$DATE^INHUT($P(BDWMDATA,U,2))
.. S INA("BDW1IN149",BDWCNT)=$P(BDWDATA,U,3)
.. N BDWREL
.. S BDWREL=$P(BDWDATA,U,6)
.. S INA("BDW1IN117",BDWCNT)=$S(BDWREL:$P($G(^AUTTRLSH(BDWREL,0)),U,1),1:"")
.. S BDWMNM=$P($G(^AUPNMCD(BDWDA,0)),U,5)
.. S INA("BDW1IN116",BDWCNT)=$P(BDWMNM,",")_U_$P($P(BDWMNM,",",2)," ")_U_$P($P(BDWMNM,",",2)," ",2)
.. ;S INA("BDW1IN117",BDWCNT)=$S($P(BDWMDATA,U,6):$P($G(^AUTTRLSH($P(BDWMDATA,U,5),0)),U),1:"")
K BDWDATA,BDWDA,BDWMDATA,BDWMDA,BDAMNM
Q
;
MCR ;-- get the medicare data for the message
Q:'$D(^AUPNMCR(DFN,0))
N BDWMNM,BDWMBI
;S BDWCNT=0
S BDWDATA=$G(^AUPNMCR(DFN,0))
Q:$P(BDWDATA,U,2)="" ;no insurer pointer
S BDWMDA=0 F S BDWMDA=$O(^AUPNMCR(DFN,11,BDWMDA)) Q:'BDWMDA D
. S BDWMDATA=$G(^AUPNMCR(DFN,11,BDWMDA,0))
. S BDWCNT=BDWCNT+1
. S INDA("IN1",BDWCNT)=""
. S INA("BDW1IN13",BDWCNT)=$P(^AUTNINS($P(BDWDATA,U,2),0),U,7)
. S INA("BDW1IN147",BDWCNT)=$P(BDWMDATA,U,3)
. S INA("BDW1IN112",BDWCNT)=$$DATE^INHUT($P(BDWMDATA,U))
. S BDWMBI=$$GETMCR^AGUTL(DFN,DT)
. S INA("BDW1IN149",BDWCNT)=$S($$HASMBI^AGUTL(DFN,DT):$P(BDWMBI,U),1:$P(BDWDATA,U,3)_U_$$GET1^DIQ(9000003,DFN,.04)) ;cmi/maw p5 05/04/2018
. ;S INA("BDW1IN149",BDWCNT)=$P(BDWDATA,U,3)_U_$$GET1^DIQ(9000003,DFN,.04) ;cmi/maw p5 05/04/2018
. S INA("BDW1IN14",BDWCNT)="MCR"_U_$$GET1^DIQ(9000003,DFN,.02)
. S INA("BDW1IN113",BDWCNT)=$$DATE^INHUT($P(BDWMDATA,U,2))
. S BDWMNM=$P($G(^AUPNMCR(DFN,21)),U)
. S INA("BDW1IN116",BDWCNT)=$P(BDWMNM,",")_U_$P($P(BDWMNM,",",2)," ")_U_$P($P(BDWMNM,",",2)," ",2)
. N BDWREL
. S BDWREL=$O(^AUTTRLSH("B","SELF",0))
. S INA("BDW1IN117",BDWCNT)=$P($G(^AUTTRLSH(BDWREL,0)),U) ;cmi/maw 4/28/04 changed back to text
K BDWMDA,BDWDATA,BDWMDATA
Q
;
RRE ;-- get the railroad data for the message
Q:'$D(^AUPNRRE(DFN,0))
N BDWMNM,BDWMBI
;S BDWCNT=0
S BDWDATA=$G(^AUPNRRE(DFN,0))
Q:$P(BDWDATA,U,2)="" ;no insurer
S BDWMDA=0 F S BDWMDA=$O(^AUPNRRE(DFN,11,BDWMDA)) Q:'BDWMDA D
. S BDWMDATA=$G(^AUPNRRE(DFN,11,BDWMDA,0))
. S BDWCNT=BDWCNT+1
. S INDA("IN1",BDWCNT)=""
. S INA("BDW1IN13",BDWCNT)=$P(^AUTNINS($P(BDWDATA,U,2),0),U,7)
. S INA("BDW1IN147",BDWCNT)=$P(BDWMDATA,U,3)
. S INA("BDW1IN112",BDWCNT)=$$DATE^INHUT($P(BDWMDATA,U))
. ;S INA("BDW1IN149",BDWCNT)=$P(BDWDATA,U,3)_U_$P(BDWDATA,U,3)
. S BDWMBI=$$GETRRE^AGUTL(DFN,DT)
. S INA("BDW1IN149",BDWCNT)=$S($$HASMBI^AGUTL(DFN,DT):$P(BDWMBI,U),1:$$VAL^XBDIQ1(9000005,DFN,.04)_U_$$VAL^XBDIQ1(9000005,DFN,.03)) ;cmi/maw p5 05/04/2018
. ;S INA("BDW1IN149",BDWCNT)=$$VAL^XBDIQ1(9000005,DFN,.04)_U_$$VAL^XBDIQ1(9000005,DFN,.03) ;cmi/maw p5 05/04/2018
. S INA("BDW1IN14",BDWCNT)="RRE"_U_$$GET1^DIQ(9000005,DFN,.02)
. S INA("BDW1IN113",BDWCNT)=$$DATE^INHUT($P(BDWMDATA,U,2))
. S BDWMNM=$P($G(^AUPNRRE(DFN,21)),U)
. S INA("BDW1IN116",BDWCNT)=$P(BDWMNM,",")_U_$P($P(BDWMNM,",",2)," ")_U_$P($P(BDWMNM,",",2)," ",2)
. N BDWREL
. S BDWREL=$O(^AUTTRLSH("B","SELF",0))
. S INA("BDW1IN117",BDWCNT)=$P($G(^AUTTRLSH(BDWREL,0)),U) ;cmi/maw 4/28/04 changed back to text
K BDWMDA,BDWDATA,BDWMDATA
Q
;
PI ;-- get the private insurance data for the message
Q:'$D(^AUPNPRVT(DFN,0))
;S BDWCNT=0
S BDWDATA=$G(^AUPNPRVT(DFN,0))
S BDWMDA=0 F S BDWMDA=$O(^AUPNPRVT(DFN,11,BDWMDA)) Q:'BDWMDA D
. Q:$P(^AUPNPRVT(DFN,11,BDWMDA,0),U)=""
. S BDWMDATA=$G(^AUPNPRVT(DFN,11,BDWMDA,0))
. S BDWCNT=BDWCNT+1
. S INDA("IN1",BDWCNT)=""
. S INA("BDW1IN13",BDWCNT)=$P(^AUTNINS($P(BDWMDATA,U),0),U,7)
. S INA("BDW1IN112",BDWCNT)=$$DATE^INHUT($P(BDWMDATA,U,6))
. S INA("BDW1IN149",BDWCNT)=$S($P(BDWMDATA,U,8):$$GET1^DIQ(9000003.1,$P(BDWMDATA,U,8),.04,"E"),1:"")
. S INA("BDW1IN14",BDWCNT)="PVT"_U_$P(^AUTNINS($P(BDWMDATA,U),0),U)
. S INA("BDW1IN113",BDWCNT)=$$DATE^INHUT($P(BDWMDATA,U,7))
. S BDWPNM=$S($P(BDWMDATA,U,8):$$GET1^DIQ(9000003.1,$P(BDWMDATA,U,8),.01,"E"),1:"")
. S INA("BDW1IN116",BDWCNT)=$P(BDWPNM,",")_U_$P($P(BDWPNM,",",2)," ")_U_$P($P(BDWPNM,",",2)," ",2)
. S INA("BDW1IN117",BDWCNT)=$S($P(BDWMDATA,U,5):$P($G(^AUTTRLSH($P(BDWMDATA,U,5),0)),U),1:"") ;cmi/maw 4/28/04 changed back to text
. S INA("BDW1IN147",BDWCNT)=$S($P(BDWMDATA,U,8):$$GET1^DIQ(9000003.1,$P(BDWMDATA,U,8),.05,"E"),1:"")
K BDWMDA,BDWDATA,BDWMDATA,BDWPNM
Q
;
BDWIN1 ; IHS/CMI/LAB - BDW Create Insurance Array for GIS DW1 Export ;
+1 ;;1.0;IHS DATA WAREHOUSE;**5**;JAN 23, 2006;Build 32
+2 ;
+3 ;
+4 ;
+5 ;
+6 ;
+7 ;this routine will populate the IN1 segment of the HL IHS DW1 A31 message
+8 ;
MAIN ;-- this is the main routine driver
+1 KILL INDA("IN1")
+2 DO MCD
DO MCR
DO RRE
DO PI
+3 QUIT
+4 ;
MCD ;-- get medicaid data for the message
+1 SET BDWCNT=0
+2 IF '$ORDER(^AUPNMCD("B",DFN,0))
QUIT
+3 SET BDWDA=0
FOR
SET BDWDA=$ORDER(^AUPNMCD("B",DFN,BDWDA))
IF 'BDWDA
QUIT
Begin DoDot:1
+4 SET BDWDATA=$GET(^AUPNMCD(BDWDA,0))
+5 SET BDWMDA=0
FOR
SET BDWMDA=$ORDER(^AUPNMCD(BDWDA,11,BDWMDA))
IF 'BDWMDA
QUIT
Begin DoDot:2
+6 SET BDWMDATA=$GET(^AUPNMCD(BDWDA,11,BDWMDA,0))
+7 SET BDWCNT=BDWCNT+1
+8 SET INDA("IN1",BDWCNT)=""
+9 SET INA("BDW1IN13",BDWCNT)=$SELECT($PIECE(BDWDATA,U,2):$PIECE(^AUTNINS($PIECE(BDWDATA,U,2),0),U,7),1:"")
+10 SET INA("BDW1IN147",BDWCNT)=$PIECE(BDWMDATA,U,3)
+11 SET INA("BDW1IN112",BDWCNT)=$$DATE^INHUT($PIECE(BDWMDATA,U))
+12 ;$P($G(^AUPNMCD(BDWDA,0)),U,10) ;IHS/CMI/LAB - changed state piece 2 to piece 3
SET INA("BDW1IN115",BDWCNT)=$SELECT($PIECE(BDWDATA,U,4):$PIECE($GET(^DIC(5,$PIECE(BDWDATA,U,4),0)),U,3),1:"")_U_$$GET1^DIQ(9000004,BDWDA,.11)
+13 SET INA("BDW1IN14",BDWCNT)="MCD"_U_$$GET1^DIQ(9000004,BDWDA,.02)
+14 SET INA("BDW1IN113",BDWCNT)=$$DATE^INHUT($PIECE(BDWMDATA,U,2))
+15 SET INA("BDW1IN149",BDWCNT)=$PIECE(BDWDATA,U,3)
+16 NEW BDWREL
+17 SET BDWREL=$PIECE(BDWDATA,U,6)
+18 SET INA("BDW1IN117",BDWCNT)=$SELECT(BDWREL:$PIECE($GET(^AUTTRLSH(BDWREL,0)),U,1),1:"")
+19 SET BDWMNM=$PIECE($GET(^AUPNMCD(BDWDA,0)),U,5)
+20 SET INA("BDW1IN116",BDWCNT)=$PIECE(BDWMNM,",")_U_$PIECE($PIECE(BDWMNM,",",2)," ")_U_$PIECE($PIECE(BDWMNM,",",2)," ",2)
+21 ;S INA("BDW1IN117",BDWCNT)=$S($P(BDWMDATA,U,6):$P($G(^AUTTRLSH($P(BDWMDATA,U,5),0)),U),1:"")
End DoDot:2
End DoDot:1
+22 KILL BDWDATA,BDWDA,BDWMDATA,BDWMDA,BDAMNM
+23 QUIT
+24 ;
MCR ;-- get the medicare data for the message
+1 IF '$DATA(^AUPNMCR(DFN,0))
QUIT
+2 NEW BDWMNM,BDWMBI
+3 ;S BDWCNT=0
+4 SET BDWDATA=$GET(^AUPNMCR(DFN,0))
+5 ;no insurer pointer
IF $PIECE(BDWDATA,U,2)=""
QUIT
+6 SET BDWMDA=0
FOR
SET BDWMDA=$ORDER(^AUPNMCR(DFN,11,BDWMDA))
IF 'BDWMDA
QUIT
Begin DoDot:1
+7 SET BDWMDATA=$GET(^AUPNMCR(DFN,11,BDWMDA,0))
+8 SET BDWCNT=BDWCNT+1
+9 SET INDA("IN1",BDWCNT)=""
+10 SET INA("BDW1IN13",BDWCNT)=$PIECE(^AUTNINS($PIECE(BDWDATA,U,2),0),U,7)
+11 SET INA("BDW1IN147",BDWCNT)=$PIECE(BDWMDATA,U,3)
+12 SET INA("BDW1IN112",BDWCNT)=$$DATE^INHUT($PIECE(BDWMDATA,U))
+13 SET BDWMBI=$$GETMCR^AGUTL(DFN,DT)
+14 ;cmi/maw p5 05/04/2018
SET INA("BDW1IN149",BDWCNT)=$SELECT($$HASMBI^AGUTL(DFN,DT):$PIECE(BDWMBI,U),1:$PIECE(BDWDATA,U,3)_U_$$GET1^DIQ(9000003,DFN,.04))
+15 ;S INA("BDW1IN149",BDWCNT)=$P(BDWDATA,U,3)_U_$$GET1^DIQ(9000003,DFN,.04) ;cmi/maw p5 05/04/2018
+16 SET INA("BDW1IN14",BDWCNT)="MCR"_U_$$GET1^DIQ(9000003,DFN,.02)
+17 SET INA("BDW1IN113",BDWCNT)=$$DATE^INHUT($PIECE(BDWMDATA,U,2))
+18 SET BDWMNM=$PIECE($GET(^AUPNMCR(DFN,21)),U)
+19 SET INA("BDW1IN116",BDWCNT)=$PIECE(BDWMNM,",")_U_$PIECE($PIECE(BDWMNM,",",2)," ")_U_$PIECE($PIECE(BDWMNM,",",2)," ",2)
+20 NEW BDWREL
+21 SET BDWREL=$ORDER(^AUTTRLSH("B","SELF",0))
+22 ;cmi/maw 4/28/04 changed back to text
SET INA("BDW1IN117",BDWCNT)=$PIECE($GET(^AUTTRLSH(BDWREL,0)),U)
End DoDot:1
+23 KILL BDWMDA,BDWDATA,BDWMDATA
+24 QUIT
+25 ;
RRE ;-- get the railroad data for the message
+1 IF '$DATA(^AUPNRRE(DFN,0))
QUIT
+2 NEW BDWMNM,BDWMBI
+3 ;S BDWCNT=0
+4 SET BDWDATA=$GET(^AUPNRRE(DFN,0))
+5 ;no insurer
IF $PIECE(BDWDATA,U,2)=""
QUIT
+6 SET BDWMDA=0
FOR
SET BDWMDA=$ORDER(^AUPNRRE(DFN,11,BDWMDA))
IF 'BDWMDA
QUIT
Begin DoDot:1
+7 SET BDWMDATA=$GET(^AUPNRRE(DFN,11,BDWMDA,0))
+8 SET BDWCNT=BDWCNT+1
+9 SET INDA("IN1",BDWCNT)=""
+10 SET INA("BDW1IN13",BDWCNT)=$PIECE(^AUTNINS($PIECE(BDWDATA,U,2),0),U,7)
+11 SET INA("BDW1IN147",BDWCNT)=$PIECE(BDWMDATA,U,3)
+12 SET INA("BDW1IN112",BDWCNT)=$$DATE^INHUT($PIECE(BDWMDATA,U))
+13 ;S INA("BDW1IN149",BDWCNT)=$P(BDWDATA,U,3)_U_$P(BDWDATA,U,3)
+14 SET BDWMBI=$$GETRRE^AGUTL(DFN,DT)
+15 ;cmi/maw p5 05/04/2018
SET INA("BDW1IN149",BDWCNT)=$SELECT($$HASMBI^AGUTL(DFN,DT):$PIECE(BDWMBI,U),1:$$VAL^XBDIQ1(9000005,DFN,.04)_U_$$VAL^XBDIQ1(9000005,DFN,.03))
+16 ;S INA("BDW1IN149",BDWCNT)=$$VAL^XBDIQ1(9000005,DFN,.04)_U_$$VAL^XBDIQ1(9000005,DFN,.03) ;cmi/maw p5 05/04/2018
+17 SET INA("BDW1IN14",BDWCNT)="RRE"_U_$$GET1^DIQ(9000005,DFN,.02)
+18 SET INA("BDW1IN113",BDWCNT)=$$DATE^INHUT($PIECE(BDWMDATA,U,2))
+19 SET BDWMNM=$PIECE($GET(^AUPNRRE(DFN,21)),U)
+20 SET INA("BDW1IN116",BDWCNT)=$PIECE(BDWMNM,",")_U_$PIECE($PIECE(BDWMNM,",",2)," ")_U_$PIECE($PIECE(BDWMNM,",",2)," ",2)
+21 NEW BDWREL
+22 SET BDWREL=$ORDER(^AUTTRLSH("B","SELF",0))
+23 ;cmi/maw 4/28/04 changed back to text
SET INA("BDW1IN117",BDWCNT)=$PIECE($GET(^AUTTRLSH(BDWREL,0)),U)
End DoDot:1
+24 KILL BDWMDA,BDWDATA,BDWMDATA
+25 QUIT
+26 ;
PI ;-- get the private insurance data for the message
+1 IF '$DATA(^AUPNPRVT(DFN,0))
QUIT
+2 ;S BDWCNT=0
+3 SET BDWDATA=$GET(^AUPNPRVT(DFN,0))
+4 SET BDWMDA=0
FOR
SET BDWMDA=$ORDER(^AUPNPRVT(DFN,11,BDWMDA))
IF 'BDWMDA
QUIT
Begin DoDot:1
+5 IF $PIECE(^AUPNPRVT(DFN,11,BDWMDA,0),U)=""
QUIT
+6 SET BDWMDATA=$GET(^AUPNPRVT(DFN,11,BDWMDA,0))
+7 SET BDWCNT=BDWCNT+1
+8 SET INDA("IN1",BDWCNT)=""
+9 SET INA("BDW1IN13",BDWCNT)=$PIECE(^AUTNINS($PIECE(BDWMDATA,U),0),U,7)
+10 SET INA("BDW1IN112",BDWCNT)=$$DATE^INHUT($PIECE(BDWMDATA,U,6))
+11 SET INA("BDW1IN149",BDWCNT)=$SELECT($PIECE(BDWMDATA,U,8):$$GET1^DIQ(9000003.1,$PIECE(BDWMDATA,U,8),.04,"E"),1:"")
+12 SET INA("BDW1IN14",BDWCNT)="PVT"_U_$PIECE(^AUTNINS($PIECE(BDWMDATA,U),0),U)
+13 SET INA("BDW1IN113",BDWCNT)=$$DATE^INHUT($PIECE(BDWMDATA,U,7))
+14 SET BDWPNM=$SELECT($PIECE(BDWMDATA,U,8):$$GET1^DIQ(9000003.1,$PIECE(BDWMDATA,U,8),.01,"E"),1:"")
+15 SET INA("BDW1IN116",BDWCNT)=$PIECE(BDWPNM,",")_U_$PIECE($PIECE(BDWPNM,",",2)," ")_U_$PIECE($PIECE(BDWPNM,",",2)," ",2)
+16 ;cmi/maw 4/28/04 changed back to text
SET INA("BDW1IN117",BDWCNT)=$SELECT($PIECE(BDWMDATA,U,5):$PIECE($GET(^AUTTRLSH($PIECE(BDWMDATA,U,5),0)),U),1:"")
+17 SET INA("BDW1IN147",BDWCNT)=$SELECT($PIECE(BDWMDATA,U,8):$$GET1^DIQ(9000003.1,$PIECE(BDWMDATA,U,8),.05,"E"),1:"")
End DoDot:1
+18 KILL BDWMDA,BDWDATA,BDWMDATA,BDWPNM
+19 QUIT
+20 ;
