BHLZP1I.m

BHLZP1I ; cmi/sitka/maw - BHL File Incoming ZP1 segment ;

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

 ;

 ;this routine has two purposes, it will be used to determine if this

 ;is a new patient or existing, and then it will be used to update

 ;other health record numbers if necessary

 ;

MAIN ;-- this is the main routine driver     

 D PROCESS,EOJ

 Q

 ;

PROCESS ;-- process and file the data

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

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

 . S BHLHRFAC=$P(@BHLTMP@(BHLDA,2),U)

 . S BHLDI=$G(@BHLTMP@(BHLDA,3))

 . S BHLRD=$G(@BHLTMP@(BHLDA,4))

 . S BHLRS=$G(@BHLTMP@(BHLDA,5))

 . K DIE,DA,DR

 . S DIE="^AUPNPAT(",DA=BHLPAT,DR="4101///`"_BHLHRFAC

 . S DR(2,9000001.41)=".02///"_BHLHRCN

 . D ^DIE

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

 . S BHLFL="^AUPNPAT("_BHLPAT_",41,",BHLFL2="9000001.41",BHLX=BHLPAT

 . S BHLVAL=BHLHRFAC

 . S BHLFLD=.03,BHLVAL2=BHLDI X BHLDIEM

 . S BHLFLD=.04,BHLVAL2=BHLRD X BHLDIEM

 . S BHLFLD=.05,BHLVAL2=BHLRS X BHLDIEM

 Q

 ;

CHKPAT ;-- this will get the HRCN and lookup to find the patient

 ;this has become obsolete with GCPR

 N BHLR

 S BHLR="ZP1",BHLSGIEN=$O(^BHLS("B",BHLR,0))

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

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

 . S BHLHRFAC=$P(@BHLTMP@(BHLDA,2),U)

 . Q:$G(@BHLTMP@(BHLDA,3))

 . S (BHLDUZ2,DUZ(2))=BHLHRFAC

 . K DIC S DIC=9000001,DIC(0)="MZ",X=BHLHRCN D ^DIC

 . I +Y>0 S BHLDFN=+Y

 . D CHKPAT^BHLPIDI

 . Q:$D(BHLPAT)

 K DIC

 Q

 ;

EOJ ;-- end of job kill variables

 K @BHLTMP

 K BHLHRCN,BHLHRFAC,BHLDR,BHLRD,BHLRD,BHLVAL,BHLFL,BHLFLD,BHLFL2

 K BHLFLD2,BHLVAL2,BHLX

 Q

 ;

BHLZP1I   ; cmi/sitka/maw - BHL File Incoming ZP1 segment ;

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

 +2       ;

 +3       ;this routine has two purposes, it will be used to determine if this

 +4       ;is a new patient or existing, and then it will be used to update

 +5       ;other health record numbers if necessary

 +6       ;

MAIN      ;-- this is the main routine driver     

 +1        DO PROCESS

           DO EOJ

 +2        QUIT 

 +3       ;

PROCESS   ;-- process and file the data

 +1        SET BHLDA=0

           FOR 

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

               IF BHLDA=""

                   QUIT 

               Begin DoDot:1

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

 +3                SET BHLHRFAC=$PIECE(@BHLTMP@(BHLDA,2),U)

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

 +5                SET BHLRD=$GET(@BHLTMP@(BHLDA,4))

 +6                SET BHLRS=$GET(@BHLTMP@(BHLDA,5))

 +7                KILL DIE,DA,DR

 +8                SET DIE="^AUPNPAT("

                   SET DA=BHLPAT

                   SET DR="4101///`"_BHLHRFAC

 +9                SET DR(2,9000001.41)=".02///"_BHLHRCN

 +10               DO ^DIE

 +11               IF $DATA(Y)

                       SET BHLERCD="NOUP41"

                       XECUTE BHLERR

                       QUIT 

 +12               SET BHLFL="^AUPNPAT("_BHLPAT_",41,"

                   SET BHLFL2="9000001.41"

                   SET BHLX=BHLPAT

 +13               SET BHLVAL=BHLHRFAC

 +14               SET BHLFLD=.03

                   SET BHLVAL2=BHLDI

                   XECUTE BHLDIEM

 +15               SET BHLFLD=.04

                   SET BHLVAL2=BHLRD

                   XECUTE BHLDIEM

 +16               SET BHLFLD=.05

                   SET BHLVAL2=BHLRS

                   XECUTE BHLDIEM

               End DoDot:1

 +17       QUIT 

 +18      ;

CHKPAT    ;-- this will get the HRCN and lookup to find the patient

 +1       ;this has become obsolete with GCPR

 +2        NEW BHLR

 +3        SET BHLR="ZP1"

           SET BHLSGIEN=$ORDER(^BHLS("B",BHLR,0))

 +4        SET BHLDA=0

           FOR 

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

               IF BHLDA=""!($DATA(BHLPAT))

                   QUIT 

               Begin DoDot:1

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

 +6                SET BHLHRFAC=$PIECE(@BHLTMP@(BHLDA,2),U)

 +7                IF $GET(@BHLTMP@(BHLDA,3))

                       QUIT 

 +8                SET (BHLDUZ2,DUZ(2))=BHLHRFAC

 +9                KILL DIC

                   SET DIC=9000001

                   SET DIC(0)="MZ"

                   SET X=BHLHRCN

                   DO ^DIC

 +10               IF +Y>0

                       SET BHLDFN=+Y

 +11               DO CHKPAT^BHLPIDI

 +12               IF $DATA(BHLPAT)

                       QUIT 

               End DoDot:1

 +13       KILL DIC

 +14       QUIT 

 +15      ;

EOJ       ;-- end of job kill variables

 +1        KILL @BHLTMP

 +2        KILL BHLHRCN,BHLHRFAC,BHLDR,BHLRD,BHLRD,BHLVAL,BHLFL,BHLFLD,BHLFL2

 +3        KILL BHLFLD2,BHLVAL2,BHLX

 +4        QUIT 

 +5       ;