- 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 ;
