BHLZV1I.m

BHLZV1I ; cmi/sitka/maw - BHL File Inbound ZV1 segment ; 

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

 ;

 ;this routine will file the inbound ZV1 segment it is called from

 ;BHLPV1I

 ;

 Q

 ;

 ;

FILE ;EP - get the data and file it

 N BHLR

 S BHLR="ZV1"

 S BHLTPB=$P($G(@BHLTMP@(BHLDA,2)),CS,2)

 S BHLCL=$G(@BHLTMP@(BHLDA,3))

 S BHLCL=$S($$DIC^BHLU(40.7,BHLCL)'<0:BHLCL,1:"")

 S BHLWIA=$P($G(@BHLTMP@(BHLDA,5)),CS,2)

 S BHLLVOS=$P($G(@BHLTMP@(BHLDA,6)),CS,2)

 S BHLELG=$P($G(@BHLTMP@(BHLDA,7)),CS,2)

 S BHLELG=$S($$DIC^BHLU(8,BHLELG):BHLELG,1:"")

 S BHLAB=$G(@BHLTMP@(BHLDA,8))

 S BHLOL=$G(@BHLTMP@(BHLDA,9))

 S BHLADS=$P($G(@BHLTMP@(BHLDA,10)),CS,2)

 S BHLADS=$S($$DIC^BHLU(45.7,BHLADS):BHLADS,1:BHLDADS)

 S BHLDDS=$P($G(@BHLTMP@(BHLDA,11)),CS,2)

 S BHLDDS=$S($$DIC^BHLU(45.7,BHLDDS):BHLDDS,1:BHLDDDS)

 S BHLNOC=$G(@BHLTMP@(BHLDA,12))

 S BHLMREL=$G(@BHLTMP@(BHLDA,13))

 S BHLAOB=$G(@BHLTMP@(BHLDA,14))

 S BHLAN=$P($G(@BHLTMP@(BHLDA,15)),CS)

 S BHLAF=$P($G(@BHLTMP@(BHLDA,15)),CS,2)

 S BHLPYS=$P($G(@BHLTMP@(BHLDA,16)),CS,2)

 S BHLTC=$G(@BHLTMP@(BHLDA,17))

 S BHLSB=$P($G(@BHLTMP@(BHLDA,18)),CS,2)

 S BHLNOV=$G(@BHLTMP@(BHLDA,19))

 S BHLHVN=$G(@BHLTMP@(BHLDA,20))

 S BHLVNDR=$G(@BHLTMP@(BHLDA,21))

 S BHLVNDR=$S($$DIC^BHLU(9999999.11,BHLVNDR):BHLVNDR,1:"")

 S BHLACT=$G(@BHLTMP@(BHLDA,22))

 S BHLTM=$G(@BHLTMP@(BHLDA,23))

 S APCDALVR("APCDTPB")=BHLTPB

 S APCDALVR("APCDCLN")=BHLCL

 Q

 ;

VF ;EP - called from BHLPV1I if this segment exists

 D VCHS,VACT

 Q

 ;

VCHS ;-- v chs

 Q:BHLAF=""

 S APCDALVR("APCDTFAC")=BHLAF

 S APCDALVR("APCDTAUT")=BHLAN

 S APCDALVR("APCDTPAY")=BHLPYS

 S APCDALVR("APCDTTC")=BHLTC

 S APCDALVR("APCDTSB")=BHLSB

 S APCDALVR("APCDTNV")=BHLNOV

 S APCDALVR("APCDTHV")=BHLHVN

 S APCDALVR("APCDTVDR")=BHLVNDR

 D ^APCDALVR

 I $D(APCDALVR("APCDAFLG")) S BHLERR="NOVCHS" X BHLERR Q

 Q

 ;

VACT ;-- v activity time

 Q:BHLACT=""

 S APCDALVR("APCDTACT")=BHLACT

 S APCDALVR("APCDDTTM")=BHLTM

 D ^APCDALVR

 I $D(APCDALVR("APCDAFLG")) S BHLERR="NOVACT" X BHLERR Q

 Q

 ;

BHLZV1I   ; cmi/sitka/maw - BHL File Inbound ZV1 segment ; 

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

 +2       ;

 +3       ;this routine will file the inbound ZV1 segment it is called from

 +4       ;BHLPV1I

 +5       ;

 +6        QUIT 

 +7       ;

 +8       ;

FILE      ;EP - get the data and file it

 +1        NEW BHLR

 +2        SET BHLR="ZV1"

 +3        SET BHLTPB=$PIECE($GET(@BHLTMP@(BHLDA,2)),CS,2)

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

 +5        SET BHLCL=$SELECT($$DIC^BHLU(40.7,BHLCL)'<0:BHLCL,1:"")

 +6        SET BHLWIA=$PIECE($GET(@BHLTMP@(BHLDA,5)),CS,2)

 +7        SET BHLLVOS=$PIECE($GET(@BHLTMP@(BHLDA,6)),CS,2)

 +8        SET BHLELG=$PIECE($GET(@BHLTMP@(BHLDA,7)),CS,2)

 +9        SET BHLELG=$SELECT($$DIC^BHLU(8,BHLELG):BHLELG,1:"")

 +10       SET BHLAB=$GET(@BHLTMP@(BHLDA,8))

 +11       SET BHLOL=$GET(@BHLTMP@(BHLDA,9))

 +12       SET BHLADS=$PIECE($GET(@BHLTMP@(BHLDA,10)),CS,2)

 +13       SET BHLADS=$SELECT($$DIC^BHLU(45.7,BHLADS):BHLADS,1:BHLDADS)

 +14       SET BHLDDS=$PIECE($GET(@BHLTMP@(BHLDA,11)),CS,2)

 +15       SET BHLDDS=$SELECT($$DIC^BHLU(45.7,BHLDDS):BHLDDS,1:BHLDDDS)

 +16       SET BHLNOC=$GET(@BHLTMP@(BHLDA,12))

 +17       SET BHLMREL=$GET(@BHLTMP@(BHLDA,13))

 +18       SET BHLAOB=$GET(@BHLTMP@(BHLDA,14))

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

 +20       SET BHLAF=$PIECE($GET(@BHLTMP@(BHLDA,15)),CS,2)

 +21       SET BHLPYS=$PIECE($GET(@BHLTMP@(BHLDA,16)),CS,2)

 +22       SET BHLTC=$GET(@BHLTMP@(BHLDA,17))

 +23       SET BHLSB=$PIECE($GET(@BHLTMP@(BHLDA,18)),CS,2)

 +24       SET BHLNOV=$GET(@BHLTMP@(BHLDA,19))

 +25       SET BHLHVN=$GET(@BHLTMP@(BHLDA,20))

 +26       SET BHLVNDR=$GET(@BHLTMP@(BHLDA,21))

 +27       SET BHLVNDR=$SELECT($$DIC^BHLU(9999999.11,BHLVNDR):BHLVNDR,1:"")

 +28       SET BHLACT=$GET(@BHLTMP@(BHLDA,22))

 +29       SET BHLTM=$GET(@BHLTMP@(BHLDA,23))

 +30       SET APCDALVR("APCDTPB")=BHLTPB

 +31       SET APCDALVR("APCDCLN")=BHLCL

 +32       QUIT 

 +33      ;

VF        ;EP - called from BHLPV1I if this segment exists

 +1        DO VCHS

           DO VACT

 +2        QUIT 

 +3       ;

VCHS      ;-- v chs

 +1        IF BHLAF=""

               QUIT 

 +2        SET APCDALVR("APCDTFAC")=BHLAF

 +3        SET APCDALVR("APCDTAUT")=BHLAN

 +4        SET APCDALVR("APCDTPAY")=BHLPYS

 +5        SET APCDALVR("APCDTTC")=BHLTC

 +6        SET APCDALVR("APCDTSB")=BHLSB

 +7        SET APCDALVR("APCDTNV")=BHLNOV

 +8        SET APCDALVR("APCDTHV")=BHLHVN

 +9        SET APCDALVR("APCDTVDR")=BHLVNDR

 +10       DO ^APCDALVR

 +11       IF $DATA(APCDALVR("APCDAFLG"))

               SET BHLERR="NOVCHS"

               XECUTE BHLERR

               QUIT 

 +12       QUIT 

 +13      ;

VACT      ;-- v activity time

 +1        IF BHLACT=""

               QUIT 

 +2        SET APCDALVR("APCDTACT")=BHLACT

 +3        SET APCDALVR("APCDDTTM")=BHLTM

 +4        DO ^APCDALVR

 +5        IF $DATA(APCDALVR("APCDAFLG"))

               SET BHLERR="NOVACT"

               XECUTE BHLERR

               QUIT 

 +6        QUIT 

 +7       ;