BHLPR1I.m

BHLPR1I ; cmi/sitka/maw - BHL File Inbound PR1 Segment ;

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

 ;

 ;this routine will file the inbound PR1 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 BHLPCT=$P($G(@BHLTMP@(BHLDA,3)),CS,3)

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

 . I BHLPCT="99IHS" S BHLPCT="ADA"

 . D @BHLPCT

 Q

 ;

C4 ;-- file this as an evaluation and management visit

 S BHLFL=9000010,BHLFLD=.17,BHLX=APCDALVR("APCDVSIT"),BHLVAL=BHLPC

 X BHLDIE

 Q

 ;

ADA ;-- file this as a dental visit

 I '$O(BHL("ZPR",0)) S BHLERCD="NODEN" X BHLERR Q

 D DEN^BHLZPRI

 S APCDALVR("APCDTSC")=BHLPC

 D ^APCDALVR

 I $D(APCDALVR("APCDAFLG")) S BHLERCD="NOVDEN" X BHLERR

 Q

 ;

I9 ;-- file this in the v procedure file

 S BHLPCDT=$G(@BHLTMP@(BHLDA,5))

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

 S BHLANSM=$G(@BHLTMP@(BHLDA,10))

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

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

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

 S APCDALVR("APCDTPRC")=BHLPC

 S APCDALVR("APCDTDX")=BHLADC

 S APCDALVR("APCDTPD")=BHLPCDT

 S APCDALVR("APCDTPP")=BHLPP

 S APCDALVR("APCDTOP")=BHLSUR

 S APCDALVR("APCDTAN")=BHLANS

 S APCDALVR("APCDTET")=BHLANSM

 I $O(BHL("ZPR",0)) D PRC^BHLZPRI

 D ^APCDALVR

 I $D(APCDALVR("APCDAFLG")) S BHLERCD="NOVPRC" X BHLERR

 Q

 ;

EOJ ;-- kill variables

 K @BHLTMP

 K BHLPC,BHLPCT,BHLNOU,BHLOPS,BHLTS,BHLPCDT,BHLANS,BHLANSM,BHLSUR,BHLPP

 K BHLADC,BHLPVN,BHLINF,BHLAA,BHLASA,BHLPRC,BHLX

 Q

 ;

BHLPR1I   ; cmi/sitka/maw - BHL File Inbound PR1 Segment ;

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

 +2       ;

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

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

 +4                IF BHLPCT="99IHS"

                       SET BHLPCT="ADA"

 +5                DO @BHLPCT

               End DoDot:1

 +6        QUIT 

 +7       ;

C4        ;-- file this as an evaluation and management visit

 +1        SET BHLFL=9000010

           SET BHLFLD=.17

           SET BHLX=APCDALVR("APCDVSIT")

           SET BHLVAL=BHLPC

 +2        XECUTE BHLDIE

 +3        QUIT 

 +4       ;

ADA       ;-- file this as a dental visit

 +1        IF '$ORDER(BHL("ZPR",0))

               SET BHLERCD="NODEN"

               XECUTE BHLERR

               QUIT 

 +2        DO DEN^BHLZPRI

 +3        SET APCDALVR("APCDTSC")=BHLPC

 +4        DO ^APCDALVR

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

               SET BHLERCD="NOVDEN"

               XECUTE BHLERR

 +6        QUIT 

 +7       ;

I9        ;-- file this in the v procedure file

 +1        SET BHLPCDT=$GET(@BHLTMP@(BHLDA,5))

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

 +3        SET BHLANSM=$GET(@BHLTMP@(BHLDA,10))

 +4        SET BHLSUR=$PIECE($GET(@BHLTMP@(BHLDA,11)),CS,2)

 +5        SET BHLPP=$GET(@BHLTMP@(BHLDA,14))

 +6        SET BHLADC=$PIECE($GET(@BHLTMP@(BHLDA,15)),CS)

 +7        SET APCDALVR("APCDTPRC")=BHLPC

 +8        SET APCDALVR("APCDTDX")=BHLADC

 +9        SET APCDALVR("APCDTPD")=BHLPCDT

 +10       SET APCDALVR("APCDTPP")=BHLPP

 +11       SET APCDALVR("APCDTOP")=BHLSUR

 +12       SET APCDALVR("APCDTAN")=BHLANS

 +13       SET APCDALVR("APCDTET")=BHLANSM

 +14       IF $ORDER(BHL("ZPR",0))

               DO PRC^BHLZPRI

 +15       DO ^APCDALVR

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

               SET BHLERCD="NOVPRC"

               XECUTE BHLERR

 +17       QUIT 

 +18      ;

EOJ       ;-- kill variables

 +1        KILL @BHLTMP

 +2        KILL BHLPC,BHLPCT,BHLNOU,BHLOPS,BHLTS,BHLPCDT,BHLANS,BHLANSM,BHLSUR,BHLPP

 +3        KILL BHLADC,BHLPVN,BHLINF,BHLAA,BHLASA,BHLPRC,BHLX

 +4        QUIT 

 +5       ;