BHLZP3I.m

BHLZP3I ; cmi/sitka/maw - BHL File Inbound ZP3 Segment ;

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

 ;

 ;this routine will file the inbound ZP3 Segment

 ;

MAIN ;-- this is the main routine driver

 D PROCESS,EOJ

 Q

 ;

PROCESS ;-- process the data in the segment

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

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

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

 . S DIE="^AUPNPAT(",DA=BHLPAT,DR="4301///"_BHLOT

 . S DR(2,9000001.43)=".02///"_BHLOTQ

 . D ^DIE

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

 Q

 ;

EOJ ;-- kill variables and quit 

 K @BHLTMP

 K BHLDA,BHLOT,BHLOTQ,BHLFL,BHLFLD,BHLVAL,BHLFL2,BHLFLD2,BHLVAL2,BHLX

 Q

 ;

BHLZP3I   ; cmi/sitka/maw - BHL File Inbound ZP3 Segment ;

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

 +2       ;

 +3       ;this routine will file the inbound ZP3 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 BHLOT=$PIECE($GET(@BHLTMP@(BHLDA,1)),CS,2)

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

 +4                SET DIE="^AUPNPAT("

                   SET DA=BHLPAT

                   SET DR="4301///"_BHLOT

 +5                SET DR(2,9000001.43)=".02///"_BHLOTQ

 +6                DO ^DIE

 +7                IF $DATA(Y)

                       SET BHLERCD="NOUP43"

                       XECUTE BHLERR

                       QUIT 

               End DoDot:1

 +8        QUIT 

 +9       ;

EOJ       ;-- kill variables and quit 

 +1        KILL @BHLTMP

 +2        KILL BHLDA,BHLOT,BHLOTQ,BHLFL,BHLFLD,BHLVAL,BHLFL2,BHLFLD2,BHLVAL2,BHLX

 +3        QUIT 

 +4       ;