BHLORCI.m

BHLORCI ; cmi/sitka/maw - BHL File Inbound ORC Segment ;

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

 ;

 ;this routine will file the inbound ORC segment

 ;

MAIN ;-- get the event type and file accordingly    

 I BHLET="O01" D VMED,EOJ Q

 D VIMM,EOJ

 Q

 ;

VIMM ;-- V immunization record

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

 . S BHLOC=$G(@BHLTMP@(BHLDA,1))

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

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

 . ;I $D(^AUPNVIMM(BHLVIEN,0)) S BHLERCD="EXVIMM" X BHLERR Q future

 . I BHLVIEN'="" Q:$D(^AUPNVIMM(BHLVIEN,0))

 . X BHLKSV

 . D VIMM^BHLRXAI

 . Q:$D(BHLMTCH)

 . I BHLIMM="" S BHLERCD="NOIMM" X BHLERR Q

 . D VIMM^BHLZRAI

 . S APCDALVR("APCDATMP")="[APCDALVR 9000010.11 (ADD)]"

 . D ^APCDALVR

 . I $D(APCDALVR("APCDAFLG")) S BHLERCD="NOVIMM" X BHLERR Q

 Q

 ;

VMED ;-- V medication record

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

 . S BHLPT=$G(@BHLTMP@(BHLDA,1))

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

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

 . S BHLOED=$G(@BHLTMP@(BHLDA,15))

 . I BHLPT="DC" S BHLFL=9000010.14,BHLFLD=.08,BHLX=BHLVIEN,BHLVAL=BHLOED X BHLDIE Q

 . I BHLVIEN'="" Q:$D(^AUPNVMED(BHLVIEN,0))

 . S BHLQTY=$P($G(@BHLTMP@(BHLDA,7)),CS)

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

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

 . S BHLOP=$P($G(@BHLTMP@(BHLDA,12)),CS,2)

 . S BHLOP=$S($$DIC^BHLU(200,BHLOP)'<0:BHLOP,1:BHLDPRV)

 . X BHLKSV

 . D VMED^BHLRXDI

 . Q:$D(BHLMTCH)

 . I BHLMED="" S BHLERCD="NOMED" X BHLERR Q

 . S APCDALVR("APCDATMP")="[APCDALVR 9000010.14 (ADD)]"

 . S APCDALVR("APCDTSIG")=BHLSIG

 . S APCDALVR("APCDTQTY")=BHLQTY

 . S APCDALVR("APCDTDAY")=BHLDAY

 . S APCDALVR("APCDTPRV")=BHLOP

 . D ^APCDALVR

 . I $D(APCDALVR("APCDAFLG")) S BHLERCD="NOVMED" X BHLERR Q

 Q

 ;

EOJ ;-- kill variables and quit

 K @BHLTMP

 K BHLDA,BHLOC,BHLVIEN,BHLVSDT,BHLIMM,BHLLOT,BHLMED,BHLDTD,BHLNTD,BHLSER

 K BHLREA,BHLCON,BHLPT,BHLOED,BHLQTY,BHLSIG,BHLDAY,BHLOP

 Q

 ;

BHLORCI   ; cmi/sitka/maw - BHL File Inbound ORC Segment ;

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

 +2       ;

 +3       ;this routine will file the inbound ORC segment

 +4       ;

MAIN      ;-- get the event type and file accordingly    

 +1        IF BHLET="O01"

               DO VMED

               DO EOJ

               QUIT 

 +2        DO VIMM

           DO EOJ

 +3        QUIT 

 +4       ;

VIMM      ;-- V immunization record

 +1        SET BHLDA=0

           FOR 

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

               IF BHLDA=""

                   QUIT 

               Begin DoDot:1

 +2                SET BHLOC=$GET(@BHLTMP@(BHLDA,1))

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

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

 +5       ;I $D(^AUPNVIMM(BHLVIEN,0)) S BHLERCD="EXVIMM" X BHLERR Q future

 +6                IF BHLVIEN'=""

                       IF $DATA(^AUPNVIMM(BHLVIEN,0))

                           QUIT 

 +7                XECUTE BHLKSV

 +8                DO VIMM^BHLRXAI

 +9                IF $DATA(BHLMTCH)

                       QUIT 

 +10               IF BHLIMM=""

                       SET BHLERCD="NOIMM"

                       XECUTE BHLERR

                       QUIT 

 +11               DO VIMM^BHLZRAI

 +12               SET APCDALVR("APCDATMP")="[APCDALVR 9000010.11 (ADD)]"

 +13               DO ^APCDALVR

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

                       SET BHLERCD="NOVIMM"

                       XECUTE BHLERR

                       QUIT 

               End DoDot:1

 +15       QUIT 

 +16      ;

VMED      ;-- V medication record

 +1        SET BHLDA=0

           FOR 

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

               IF BHLDA=""

                   QUIT 

               Begin DoDot:1

 +2                SET BHLPT=$GET(@BHLTMP@(BHLDA,1))

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

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

 +5                SET BHLOED=$GET(@BHLTMP@(BHLDA,15))

 +6                IF BHLPT="DC"

                       SET BHLFL=9000010.14

                       SET BHLFLD=.08

                       SET BHLX=BHLVIEN

                       SET BHLVAL=BHLOED

                       XECUTE BHLDIE

                       QUIT 

 +7                IF BHLVIEN'=""

                       IF $DATA(^AUPNVMED(BHLVIEN,0))

                           QUIT 

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

 +9                SET BHLSIG=$PIECE($GET(@BHLTMP@(BHLDA,7)),CS,2)

 +10               SET BHLDAY=$PIECE($GET(@BHLTMP@(BHLDA,7)),CS,3)

 +11               SET BHLOP=$PIECE($GET(@BHLTMP@(BHLDA,12)),CS,2)

 +12               SET BHLOP=$SELECT($$DIC^BHLU(200,BHLOP)'<0:BHLOP,1:BHLDPRV)

 +13               XECUTE BHLKSV

 +14               DO VMED^BHLRXDI

 +15               IF $DATA(BHLMTCH)

                       QUIT 

 +16               IF BHLMED=""

                       SET BHLERCD="NOMED"

                       XECUTE BHLERR

                       QUIT 

 +17               SET APCDALVR("APCDATMP")="[APCDALVR 9000010.14 (ADD)]"

 +18               SET APCDALVR("APCDTSIG")=BHLSIG

 +19               SET APCDALVR("APCDTQTY")=BHLQTY

 +20               SET APCDALVR("APCDTDAY")=BHLDAY

 +21               SET APCDALVR("APCDTPRV")=BHLOP

 +22               DO ^APCDALVR

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

                       SET BHLERCD="NOVMED"

                       XECUTE BHLERR

                       QUIT 

               End DoDot:1

 +24       QUIT 

 +25      ;

EOJ       ;-- kill variables and quit

 +1        KILL @BHLTMP

 +2        KILL BHLDA,BHLOC,BHLVIEN,BHLVSDT,BHLIMM,BHLLOT,BHLMED,BHLDTD,BHLNTD,BHLSER

 +3        KILL BHLREA,BHLCON,BHLPT,BHLOED,BHLQTY,BHLSIG,BHLDAY,BHLOP

 +4        QUIT 

 +5       ;