BHLIN1IA.m

BHLIN1IA ; cmi/sitka/maw - BHL File Inbound IN1 Segment (cont) ;   

 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 ;

 ;this routine will file the inbound IN1 segment

 ;

 Q

 ;

UPI ;EP -- update private insurance

 S BHLPIMM=""

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

 . S BHLDATA=$G(^AUPNPRVT(BHLPAT,11,BHLPIM,0))

 . I $P(BHLDATA,U)=BHLICNI,$P(BHLDATA,U,6)=BHLPED,$P(BHLDATA,U,8)=BHLPH S BHLPIMM=BHLPIM Q

 I BHLPIMM="" D  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

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

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

 S DR=".02///"_BHLIID_";.04///"_BHLNOI

 S DR=DR_";.07///"_BHLPEXD

 D ^DIE

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

 Q

 ;

BHLIN1IA  ; cmi/sitka/maw - BHL File Inbound IN1 Segment (cont) ;   

 +1       ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 +2       ;

 +3       ;this routine will file the inbound IN1 segment

 +4       ;

 +5        QUIT 

 +6       ;

UPI       ;EP -- update private insurance

 +1        SET BHLPIMM=""

 +2        SET BHLPIM=0

           FOR 

               SET BHLPIM=$ORDER(^AUPNPRVT(BHLPAT,11,BHLPIM))

               IF BHLPIM=""

                   QUIT 

               Begin DoDot:1

 +3                SET BHLDATA=$GET(^AUPNPRVT(BHLPAT,11,BHLPIM,0))

 +4                IF $PIECE(BHLDATA,U)=BHLICNI

                       IF $PIECE(BHLDATA,U,6)=BHLPED

                           IF $PIECE(BHLDATA,U,8)=BHLPH

                               SET BHLPIMM=BHLPIM

                               QUIT 

               End DoDot:1

 +5        IF BHLPIMM=""

               Begin DoDot:1

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

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

                   SET DIC(0)="L"

                   SET DA(1)=BHLPAT

 +8                SET X="`"_BHLICN

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

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

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

 +11               DO ^DIC

 +12               IF Y<0

                       SET BHLERCD="NOPIEM"

                       XECUTE BHLERR

                       QUIT 

               End DoDot:1

               QUIT 

 +13       SET DIE="^AUPNPRVT("_BHLPAT_",11,"

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

           SET DA=BHLPIMM

           SET DA(1)=BHLPAT

 +15       SET DR=".02///"_BHLIID_";.04///"_BHLNOI

 +16       SET DR=DR_";.07///"_BHLPEXD

 +17       DO ^DIE

 +18       IF $DATA(Y)

               SET BHLERCD="NOUPIEM"

               XECUTE BHLERR

               QUIT 

 +19       QUIT 

 +20      ;