Routine: BDWIN1

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

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

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

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

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

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      ;

BDWIN1.m