Routine: BHLZP4I

BHLZP4I ; cmi/sitka/maw - BHL File Inbound ZP4 Segment ;

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

 ;this routine will file the inbound ZP4 Segment

MAIN ;-- this is the main routine driver

 D PROCESS,EOJ

PROCESS ;-- process the data in the segment

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

 . S BHLPC=$P($G(@BHLTMP@(BHLDA,1)),CS,2)

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

 . S BHLDAF=$G(@BHLTMP@(BHLDA,3))

 . S DIE="^AUPNPAT(",DA=BHLPAT,DR="5101///"_BHLDM

 . S DR(2,9000001.51)=".02///"_BHLDAF

 . D ^DIE

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

 . S BHLFL="^AUPNPAT("_BHLPAT_",51,",BHLFL2="9000001.51",BHLX=BHLPAT

 . S BHLVAL=BHLDM

 . S BHLFLD=.03,BHLVAL2=BHLPC X BHLDIEM

EOJ ;-- kill variables and quit

 K @BHLTMP

 K BHLDA,BHLPC,BHLDM,BHLDAF,BHLFL,BHLFLD,BHLVAL,BHLFL2,BHLFLD2,BHLVAL2

 K BHLX

BHLZP4I   ; cmi/sitka/maw - BHL File Inbound ZP4 Segment ;

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

 +2       ;

 +3       ;this routine will file the inbound ZP4 Segment

 +4       ;

MAIN      ;-- this is the main routine driver

 +1        DO PROCESS

           DO EOJ

 +2        QUIT

 +3       ;

PROCESS   ;-- process the data in the segment

 +1        SET BHLDA=0

FOR

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

               IF BHLDA=""

                   QUIT

               Begin DoDot:1

 +2                SET BHLPC=$PIECE($GET(@BHLTMP@(BHLDA,1)),CS,2)

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

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

 +5                SET DIE="^AUPNPAT("

                   SET DA=BHLPAT

                   SET DR="5101///"_BHLDM

 +6                SET DR(2,9000001.51)=".02///"_BHLDAF

 +7                DO ^DIE

 +8                IF $DATA(Y)

                       SET BHLERCD="NOUP51"

                       XECUTE BHLERR

                       QUIT

 +9                SET BHLFL="^AUPNPAT("_BHLPAT_",51,"

                   SET BHLFL2="9000001.51"

                   SET BHLX=BHLPAT

 +10               SET BHLVAL=BHLDM

 +11               SET BHLFLD=.03

                   SET BHLVAL2=BHLPC

                   XECUTE BHLDIEM

               End DoDot:1

 +12       QUIT

 +13      ;

EOJ       ;-- kill variables and quit

 +1        KILL @BHLTMP

 +2        KILL BHLDA,BHLPC,BHLDM,BHLDAF,BHLFL,BHLFLD,BHLVAL,BHLFL2,BHLFLD2,BHLVAL2

 +3        KILL BHLX

 +4        QUIT

 +5       ;

BHLZP4I.m