BHLIN1I.m

BHLIN1I ; cmi/flag/maw - BHL File Inbound IN1 Segment ;

 ;;3.01;BHL IHS Interfaces with GIS;**1**;JUN 01, 2002

 ;

 ;this routine will file the inbound IN1 segment

 ;

MAIN ;-- this is the main routine driver

 D FILE,EOJ

 Q

 ;

FILE ;-- get the data and file it     

 S BHLDA=0 F  S BHLDA=$O(@BHLTMP@(BHLDA)) Q:BHLDA=""  D

 . S BHLICM=$G(@BHLTMP@(BHLDA,2))

 . S BHLICN=$G(@BHLTMP@(BHLDA,4))

 . ;S BHLICNI=$O(^AUTNINS("MI",BHLICM,0)) only if site has insurer map

 . S BHLGN=$G(@BHLTMP@(BHLDA,8))

 . S BHLGNM=$G(@BHLTMP@(BHLDA,9))

 . S BHLPED=$G(@BHLTMP@(BHLDA,12))

 . S BHLPEDE=$$FMTE^XLFDT(BHLPED)

 . S BHLPEXD=$G(@BHLTMP@(BHLDA,13))

 . S BHLPEXDE=$$FMTE^XLFDT(BHLPEXD)

 . S BHLNOI=$G(@BHLTMP@(BHLDA,16))

 . S BHLIDOB=$G(@BHLTMP@(BHLDA,18))

 . S BHLSTR=$P($G(@BHLTMP@(BHLDA,19)),CS)

 . S BHLCTY=$P($G(@BHLTMP@(BHLDA,19)),CS,3)

 . S BHLST=$P($G(@BHLTMP@(BHLDA,19)),CS,4)

 . S BHLZP=$P($G(@BHLTMP@(BHLDA,19)),CS,5)

 . S BHLISX=$G(@BHLTMP@(BHLDA,43))

 . S BHLCT=$G(@BHLTMP@(BHLDA,47))

 . ;S BHLIID=$G(@BHLTMP@(BHLDA,36))

 . S BHLIID=$G(@BHLTMP@(BHLDA,49))

 . S BHLIT="PI"

 . I BHLICN="MEDICAID" S BHLIT="MCD"

 . I BHLICN="MEDICARE" S BHLIT="MCR"

 . D @BHLIT

 . D FILE^BHLIN2I

 . D FK^BHLU

 Q

 ;

MCD ;-- file medicaid data

 S (BHLMCDE,BHLMCME)=""

 I BHLIID="" S BHLERCD="NOMCDN" X BHLERR Q

 I BHLPED="" S BHLERCD="NOMCDED" X BHLERR Q

 S BHLMCD=0 F  S BHLMCD=$O(^AUPNMCD("B",BHLPAT,BHLMCD)) Q:BHLMCD=""  D

 . I $P(^AUPNMCD(BHLMCD,0),U,3)=BHLIID S BHLMCDE=BHLMCD Q

 I BHLMCDE="" D  Q

 . S DIC="^AUPNMCD(",DIC(0)="L",DLAYGO=9000004,X=BHLPAT

 . S DIC("DR")=".02///"_BHLICN_";.03///"_BHLIID_";.04///"_BHLGN

 . S DIC("DR")=DIC("DR")_";.05///"_BHLNOI

 . K DD,DO

 . D FILE^DICN

 . I Y<0 S BHLERCD="NOMCD" X BHLERR Q

 . S BHLMCDE=+Y

 . S DIC="^AUPNMCD("_BHLMCDE_",11,",DIC("P")=$P(^DD(9000004,1101,0),U,2)

 . S DIC(0)="L",DA(1)=BHLMCDE,X=BHLPED,DIC("DR")=".02///"_BHLPEXD

 . S DIC("DR")=DIC("DR")_";.03///"_BHLCT

 . D ^DIC

 . I Y<0 S BHLERCD="NOMCDM" X BHLERR Q

 S BHLMCM=0 F  S BHLMCM=$O(^AUPNMCD(BHLMCDE,11,BHLMCM)) Q:BHLMCM=""  D

 . S BHLDATA=$G(^AUPNMCD(BHLMCDE,11,BHLMCM,0))

 . I BHLMCM=BHLPED,$P(BHLDATA,U,3)=BHLCT S BHLMCME=BHLMCM Q

 Q:'$D(^AUPNMCD(BHLMCDE,0))

 I BHLMCME="" D  Q

 . S DIC="^AUPNMCD("_BHLMCDE_",11,",DIC("P")=$P(^DD(9000004,1101,0),U,2)

 . S DIC(0)="L",DA(1)=BHLMCDE,X=BHLPED,DIC("DR")=".02///"_BHLPEXD

 . S DIC("DR")=DIC("DR")_";.03///"_BHLCT

 . D ^DIC

 . I Y<0 S BHLERCD="NOMCDM" X BHLERR Q

 S DIE="^AUPNMCD("_BHLMCDE_",11,",DA(1)=BHLMCDE,DA=BHLMCME

 S DR=".02///"_BHLPEXD_";.03///"_BHLCT

 D ^DIE

 I $D(Y) S BHLERCD="NOUPMCDM" X BHLERR Q

 Q

 ;

MCR ;-- file medicare data

 S BHLMCRE=""

 I BHLIID="" S BHLERCD="NOMCRN" X BHLERR Q

 I BHLPED="" S BHLERCD="NOMCRED" X BHLERR Q

 I '$D(^AUPNMCR(BHLPAT,0)) D  Q

 . S DIC="^AUPNMCR(",DLAYGO=9000003,X=BHLPAT,DINUM=X,DIC(0)="L"

 . S DIC("DR")=".02///"_BHLICN_";.03///"_BHLIID_";.04///"_BHLGN

 . K DD,DO

 . D FILE^DICN

 . K DINUM

 . I Y<0 S BHLERCD="NOMCR" X BHLERR Q

 . S DIC="^AUPNMCR("_BHLPAT_",11,",DIC("P")=$P(^DD(9000003,1101,0),U,2)

 . S DIC(0)="L",DA(1)=BHLPAT,X=BHLPED

 . S DIC("DR")=".02///"_BHLPEXD_";.03///"_BHLCT

 . D ^DIC

 . I Y<0 S BHLERCD="NOMCRM" X BHLERR Q

 S DIE="^AUPNMCR(",DA=BHLPAT,DR=".03///"_BHLIID_";.04///"_BHLGN

 S DR=DR_";2101///"_BHLNOI

 D ^DIE

 I $D(Y) S BHLERCD="NOUPMCR" X BHLERR Q

 S BHLMCR=0 F  S BHLMCR=$O(^AUPNMCR(BHLPAT,11,BHLMCR)) Q:BHLMCR=""  D

 . S BHLDATA=$G(^AUPNMCR(BHLPAT,11,BHLMCR,0))

 . I $P(BHLDATA,U)=BHLPED,$P(BHLDATA,U,3)=BHLCT S BHLMCRE=BHLMCR Q

 Q:'$D(^AUPNMCR(BHLPAT,0))

 I BHLMCRE="" D  Q

 . S DIC="^AUPNMCR("_BHLPAT_",11,",DIC("P")=$P(^DD(9000003,1101,0),U,2)

 . S DIC(0)="L",DA(1)=BHLPAT,X=BHLPED

 . S DIC("DR")=".02///"_BHLPEXD_";.03///"_BHLCT

 . D ^DIC

 . I Y<0 S BHLERCD="NOMCRM" X BHLERR Q

 S DIE="^AUPNMCR("_DFN_",11,",DA(1)=BHLPAT,DA=BHLMCRE

 S DR=".02///"_BHLPEXD

 D ^DIE

 I $D(Y) S BHLERCD="NOUPMCRM" X BHLERR Q

 Q

 ;

PI ;-- file private insurance data

 S BHLPH=""

 ;S BHLICN=$O(^AUTNINS("MI",BHLICM,0)) only if site has insurer map

 I BHLICN="" S BHLERCD="NOICN" X BHLERR Q

 Q:BHLIID=""

 S BHLMA=0 F  S BHLMA=$O(^AUPN3PPH("D",BHLIID,BHLMA)) Q:BHLMA=""  D

 . I $P(^AUPN3PPH(BHLMA,0),U,3)=BHLICNI S BHLPH=BHLMA Q

 I BHLPH="" D  Q:$D(BHLERCD)

 . Q:BHLNOI=""

 . S DIC="^AUPN3PPH(",X=BHLNOI,DLAYGO=9000003.1,DIC(0)="L"

 . S DIC("DR")=".03////"_BHLICN_";.04///"_BHLIID

 . S DIC("DR")=DIC("DR")_";.08///"_BHLISX_";.09///"_BHLSTR

 . S DIC("DR")=DIC("DR")_";.11///"_BHLCTY_";.12///"_BHLST

 . S DIC("DR")=DIC("DR")_";.13///"_BHLZP_";.17///"_BHLPED

 . S DIC("DR")=DIC("DR")_";.18///"_BHLPEXD

 . K DD,D0,DO

 . D FILE^DICN

 . I Y<0 S BHLERCD="NO3PPH" X BHLERR Q

 . S BHLPH=+Y

 Q:BHLNOI=""

 I $D(^AUPNPRVT(BHLPAT,0)) D UPI^BHLIN1IA Q

 S DIC="^AUPNPRVT(",DLAYGO=9000006,DIC(0)="L",X=BHLPAT,DINUM=X

 K DD,DO

 D FILE^DICN

 K DINUM

 I Y<0 S BHLERCD="NOPIE" X BHLERR Q

 S DIC="^AUPNPRVT("_BHLPAT_",11,"

 S DIC("P")=$P(^DD(9000006,1101,0),U,2),DIC(0)="L",DA(1)=BHLPAT

 S X="`"_BHLICN,DIC("DR")=".02///"_BHLIID_";.04///"_BHLNOI

 S DIC("DR")=DIC("DR")_";.06///"_BHLPED_";.07///"_BHLPEXD

 S DIC("DR")=DIC("DR")_";.08///"_BHLPH

 D ^DIC

 I Y<0 S BHLERCD="NOPIEM" X BHLERR Q

 Q

 ;

EOJ ;-- kill variables     

 K @BHLTMP

 K BHLICN,BHLGN,BHLGNM,BHLPED,BHLPEXD,BHLNOI,BHLIDOB,BHLSTR,BHLCTY

 K BHLST,BHLZP,BHLISX,BHLIID,BHLIT,BHLMCD,BHLMCDE,BHLMCM,BHLMCME

 K BHLMCR,BHLMCRE,BHLMA,BHLPH,BHLICNI

 Q

 ;

BHLIN1I   ; cmi/flag/maw - BHL File Inbound IN1 Segment ;

 +1       ;;3.01;BHL IHS Interfaces with GIS;**1**;JUN 01, 2002

 +2       ;

 +3       ;this routine will file the inbound IN1 segment

 +4       ;

MAIN      ;-- this is the main routine driver

 +1        DO FILE

           DO EOJ

 +2        QUIT 

 +3       ;

FILE      ;-- get the data and file it     

 +1        SET BHLDA=0

           FOR 

               SET BHLDA=$ORDER(@BHLTMP@(BHLDA))

               IF BHLDA=""

                   QUIT 

               Begin DoDot:1

 +2                SET BHLICM=$GET(@BHLTMP@(BHLDA,2))

 +3                SET BHLICN=$GET(@BHLTMP@(BHLDA,4))

 +4       ;S BHLICNI=$O(^AUTNINS("MI",BHLICM,0)) only if site has insurer map

 +5                SET BHLGN=$GET(@BHLTMP@(BHLDA,8))

 +6                SET BHLGNM=$GET(@BHLTMP@(BHLDA,9))

 +7                SET BHLPED=$GET(@BHLTMP@(BHLDA,12))

 +8                SET BHLPEDE=$$FMTE^XLFDT(BHLPED)

 +9                SET BHLPEXD=$GET(@BHLTMP@(BHLDA,13))

 +10               SET BHLPEXDE=$$FMTE^XLFDT(BHLPEXD)

 +11               SET BHLNOI=$GET(@BHLTMP@(BHLDA,16))

 +12               SET BHLIDOB=$GET(@BHLTMP@(BHLDA,18))

 +13               SET BHLSTR=$PIECE($GET(@BHLTMP@(BHLDA,19)),CS)

 +14               SET BHLCTY=$PIECE($GET(@BHLTMP@(BHLDA,19)),CS,3)

 +15               SET BHLST=$PIECE($GET(@BHLTMP@(BHLDA,19)),CS,4)

 +16               SET BHLZP=$PIECE($GET(@BHLTMP@(BHLDA,19)),CS,5)

 +17               SET BHLISX=$GET(@BHLTMP@(BHLDA,43))

 +18               SET BHLCT=$GET(@BHLTMP@(BHLDA,47))

 +19      ;S BHLIID=$G(@BHLTMP@(BHLDA,36))

 +20               SET BHLIID=$GET(@BHLTMP@(BHLDA,49))

 +21               SET BHLIT="PI"

 +22               IF BHLICN="MEDICAID"

                       SET BHLIT="MCD"

 +23               IF BHLICN="MEDICARE"

                       SET BHLIT="MCR"

 +24               DO @BHLIT

 +25               DO FILE^BHLIN2I

 +26               DO FK^BHLU

               End DoDot:1

 +27       QUIT 

 +28      ;

MCD       ;-- file medicaid data

 +1        SET (BHLMCDE,BHLMCME)=""

 +2        IF BHLIID=""

               SET BHLERCD="NOMCDN"

               XECUTE BHLERR

               QUIT 

 +3        IF BHLPED=""

               SET BHLERCD="NOMCDED"

               XECUTE BHLERR

               QUIT 

 +4        SET BHLMCD=0

           FOR 

               SET BHLMCD=$ORDER(^AUPNMCD("B",BHLPAT,BHLMCD))

               IF BHLMCD=""

                   QUIT 

               Begin DoDot:1

 +5                IF $PIECE(^AUPNMCD(BHLMCD,0),U,3)=BHLIID

                       SET BHLMCDE=BHLMCD

                       QUIT 

               End DoDot:1

 +6        IF BHLMCDE=""

               Begin DoDot:1

 +7                SET DIC="^AUPNMCD("

                   SET DIC(0)="L"

                   SET DLAYGO=9000004

                   SET X=BHLPAT

 +8                SET DIC("DR")=".02///"_BHLICN_";.03///"_BHLIID_";.04///"_BHLGN

 +9                SET DIC("DR")=DIC("DR")_";.05///"_BHLNOI

 +10               KILL DD,DO

 +11               DO FILE^DICN

 +12               IF Y<0

                       SET BHLERCD="NOMCD"

                       XECUTE BHLERR

                       QUIT 

 +13               SET BHLMCDE=+Y

 +14               SET DIC="^AUPNMCD("_BHLMCDE_",11,"

                   SET DIC("P")=$PIECE(^DD(9000004,1101,0),U,2)

 +15               SET DIC(0)="L"

                   SET DA(1)=BHLMCDE

                   SET X=BHLPED

                   SET DIC("DR")=".02///"_BHLPEXD

 +16               SET DIC("DR")=DIC("DR")_";.03///"_BHLCT

 +17               DO ^DIC

 +18               IF Y<0

                       SET BHLERCD="NOMCDM"

                       XECUTE BHLERR

                       QUIT 

               End DoDot:1

               QUIT 

 +19       SET BHLMCM=0

           FOR 

               SET BHLMCM=$ORDER(^AUPNMCD(BHLMCDE,11,BHLMCM))

               IF BHLMCM=""

                   QUIT 

               Begin DoDot:1

 +20               SET BHLDATA=$GET(^AUPNMCD(BHLMCDE,11,BHLMCM,0))

 +21               IF BHLMCM=BHLPED

                       IF $PIECE(BHLDATA,U,3)=BHLCT

                           SET BHLMCME=BHLMCM

                           QUIT 

               End DoDot:1

 +22       IF '$DATA(^AUPNMCD(BHLMCDE,0))

               QUIT 

 +23       IF BHLMCME=""

               Begin DoDot:1

 +24               SET DIC="^AUPNMCD("_BHLMCDE_",11,"

                   SET DIC("P")=$PIECE(^DD(9000004,1101,0),U,2)

 +25               SET DIC(0)="L"

                   SET DA(1)=BHLMCDE

                   SET X=BHLPED

                   SET DIC("DR")=".02///"_BHLPEXD

 +26               SET DIC("DR")=DIC("DR")_";.03///"_BHLCT

 +27               DO ^DIC

 +28               IF Y<0

                       SET BHLERCD="NOMCDM"

                       XECUTE BHLERR

                       QUIT 

               End DoDot:1

               QUIT 

 +29       SET DIE="^AUPNMCD("_BHLMCDE_",11,"

           SET DA(1)=BHLMCDE

           SET DA=BHLMCME

 +30       SET DR=".02///"_BHLPEXD_";.03///"_BHLCT

 +31       DO ^DIE

 +32       IF $DATA(Y)

               SET BHLERCD="NOUPMCDM"

               XECUTE BHLERR

               QUIT 

 +33       QUIT 

 +34      ;

MCR       ;-- file medicare data

 +1        SET BHLMCRE=""

 +2        IF BHLIID=""

               SET BHLERCD="NOMCRN"

               XECUTE BHLERR

               QUIT 

 +3        IF BHLPED=""

               SET BHLERCD="NOMCRED"

               XECUTE BHLERR

               QUIT 

 +4        IF '$DATA(^AUPNMCR(BHLPAT,0))

               Begin DoDot:1

 +5                SET DIC="^AUPNMCR("

                   SET DLAYGO=9000003

                   SET X=BHLPAT

                   SET DINUM=X

                   SET DIC(0)="L"

 +6                SET DIC("DR")=".02///"_BHLICN_";.03///"_BHLIID_";.04///"_BHLGN

 +7                KILL DD,DO

 +8                DO FILE^DICN

 +9                KILL DINUM

 +10               IF Y<0

                       SET BHLERCD="NOMCR"

                       XECUTE BHLERR

                       QUIT 

 +11               SET DIC="^AUPNMCR("_BHLPAT_",11,"

                   SET DIC("P")=$PIECE(^DD(9000003,1101,0),U,2)

 +12               SET DIC(0)="L"

                   SET DA(1)=BHLPAT

                   SET X=BHLPED

 +13               SET DIC("DR")=".02///"_BHLPEXD_";.03///"_BHLCT

 +14               DO ^DIC

 +15               IF Y<0

                       SET BHLERCD="NOMCRM"

                       XECUTE BHLERR

                       QUIT 

               End DoDot:1

               QUIT 

 +16       SET DIE="^AUPNMCR("

           SET DA=BHLPAT

           SET DR=".03///"_BHLIID_";.04///"_BHLGN

 +17       SET DR=DR_";2101///"_BHLNOI

 +18       DO ^DIE

 +19       IF $DATA(Y)

               SET BHLERCD="NOUPMCR"

               XECUTE BHLERR

               QUIT 

 +20       SET BHLMCR=0

           FOR 

               SET BHLMCR=$ORDER(^AUPNMCR(BHLPAT,11,BHLMCR))

               IF BHLMCR=""

                   QUIT 

               Begin DoDot:1

 +21               SET BHLDATA=$GET(^AUPNMCR(BHLPAT,11,BHLMCR,0))

 +22               IF $PIECE(BHLDATA,U)=BHLPED

                       IF $PIECE(BHLDATA,U,3)=BHLCT

                           SET BHLMCRE=BHLMCR

                           QUIT 

               End DoDot:1

 +23       IF '$DATA(^AUPNMCR(BHLPAT,0))

               QUIT 

 +24       IF BHLMCRE=""

               Begin DoDot:1

 +25               SET DIC="^AUPNMCR("_BHLPAT_",11,"

                   SET DIC("P")=$PIECE(^DD(9000003,1101,0),U,2)

 +26               SET DIC(0)="L"

                   SET DA(1)=BHLPAT

                   SET X=BHLPED

 +27               SET DIC("DR")=".02///"_BHLPEXD_";.03///"_BHLCT

 +28               DO ^DIC

 +29               IF Y<0

                       SET BHLERCD="NOMCRM"

                       XECUTE BHLERR

                       QUIT 

               End DoDot:1

               QUIT 

 +30       SET DIE="^AUPNMCR("_DFN_",11,"

           SET DA(1)=BHLPAT

           SET DA=BHLMCRE

 +31       SET DR=".02///"_BHLPEXD

 +32       DO ^DIE

 +33       IF $DATA(Y)

               SET BHLERCD="NOUPMCRM"

               XECUTE BHLERR

               QUIT 

 +34       QUIT 

 +35      ;

PI        ;-- file private insurance data

 +1        SET BHLPH=""

 +2       ;S BHLICN=$O(^AUTNINS("MI",BHLICM,0)) only if site has insurer map

 +3        IF BHLICN=""

               SET BHLERCD="NOICN"

               XECUTE BHLERR

               QUIT 

 +4        IF BHLIID=""

               QUIT 

 +5        SET BHLMA=0

           FOR 

               SET BHLMA=$ORDER(^AUPN3PPH("D",BHLIID,BHLMA))

               IF BHLMA=""

                   QUIT 

               Begin DoDot:1

 +6                IF $PIECE(^AUPN3PPH(BHLMA,0),U,3)=BHLICNI

                       SET BHLPH=BHLMA

                       QUIT 

               End DoDot:1

 +7        IF BHLPH=""

               Begin DoDot:1

 +8                IF BHLNOI=""

                       QUIT 

 +9                SET DIC="^AUPN3PPH("

                   SET X=BHLNOI

                   SET DLAYGO=9000003.1

                   SET DIC(0)="L"

 +10               SET DIC("DR")=".03////"_BHLICN_";.04///"_BHLIID

 +11               SET DIC("DR")=DIC("DR")_";.08///"_BHLISX_";.09///"_BHLSTR

 +12               SET DIC("DR")=DIC("DR")_";.11///"_BHLCTY_";.12///"_BHLST

 +13               SET DIC("DR")=DIC("DR")_";.13///"_BHLZP_";.17///"_BHLPED

 +14               SET DIC("DR")=DIC("DR")_";.18///"_BHLPEXD

 +15               KILL DD,D0,DO

 +16               DO FILE^DICN

 +17               IF Y<0

                       SET BHLERCD="NO3PPH"

                       XECUTE BHLERR

                       QUIT 

 +18               SET BHLPH=+Y

               End DoDot:1

               IF $DATA(BHLERCD)

                   QUIT 

 +19       IF BHLNOI=""

               QUIT 

 +20       IF $DATA(^AUPNPRVT(BHLPAT,0))

               DO UPI^BHLIN1IA

               QUIT 

 +21       SET DIC="^AUPNPRVT("

           SET DLAYGO=9000006

           SET DIC(0)="L"

           SET X=BHLPAT

           SET DINUM=X

 +22       KILL DD,DO

 +23       DO FILE^DICN

 +24       KILL DINUM

 +25       IF Y<0

               SET BHLERCD="NOPIE"

               XECUTE BHLERR

               QUIT 

 +26       SET DIC="^AUPNPRVT("_BHLPAT_",11,"

 +27       SET DIC("P")=$PIECE(^DD(9000006,1101,0),U,2)

           SET DIC(0)="L"

           SET DA(1)=BHLPAT

 +28       SET X="`"_BHLICN

           SET DIC("DR")=".02///"_BHLIID_";.04///"_BHLNOI

 +29       SET DIC("DR")=DIC("DR")_";.06///"_BHLPED_";.07///"_BHLPEXD

 +30       SET DIC("DR")=DIC("DR")_";.08///"_BHLPH

 +31       DO ^DIC

 +32       IF Y<0

               SET BHLERCD="NOPIEM"

               XECUTE BHLERR

               QUIT 

 +33       QUIT 

 +34      ;

EOJ       ;-- kill variables     

 +1        KILL @BHLTMP

 +2        KILL BHLICN,BHLGN,BHLGNM,BHLPED,BHLPEXD,BHLNOI,BHLIDOB,BHLSTR,BHLCTY

 +3        KILL BHLST,BHLZP,BHLISX,BHLIID,BHLIT,BHLMCD,BHLMCDE,BHLMCM,BHLMCME

 +4        KILL BHLMCR,BHLMCRE,BHLMA,BHLPH,BHLICNI

 +5        QUIT 

 +6       ;