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 ;
