Routine: BPCLALL1

BPCLALL1 ; IHS/OIT/MJL - CONT BPCLALL LOAD INIT DATA PAT CHART ;

 ;;1.5;BPC;;MAY 26, 2005

MEAS ;EP CALL FROM BPCPC

 S BPCCN1=0,BPCY="" F  S BPCY=$O(^AUPNVMSR("AD",BPCVSIT,BPCY)) Q:BPCY=""  D

 . S BPCCN1=BPCCN1+1

 . S BPCMDTA=$G(^AUPNVMSR(BPCY,0)),BPCVDTA=$G(^AUPNVSIT(BPCVSIT,0)),BPCVDATE=$P(BPCVDTA,U,1)

 . S BPCTYP=$P(BPCMDTA,U,1),BPCMDESC=$P($G(^AUTTMSR(BPCTYP,0)),U,2)

 . S BPCVAL=$P(BPCMDTA,U,4)

 . S ^BGUTMP(BPCSUB,BPCX,"MEAS",BPCMDESC,BPCCN1)=BPCVDATE_U_"MEAS"_U_BPCMDESC_U_BPCVAL_U_BPCY  ;FHL 8/4/98 ADDED MEASUREMENT IEN (BPCY) TO STRING

SITEP ;EP CALL FROM BPVLALL

 I '$D(^BLRSITE("B",DUZ(2))) S ^BGURES(BPCSUB,BPCCTR)="SITEP^",BPCCTR=BPCCTR+1 Q

 S BPCIEN=$O(^BLRSITE("B",DUZ(2),"")),BPCIEN="`"_BPCIEN,BPCFILE=9009029

 S BPCFLDS="1101;1102;1103;1104;1105"

 D FIND^DIC(BPCFILE,"",BPCFLDS,"",BPCIEN)

 S BPCDTA="SITEP"

 S BPCX="" F  S BPCX=$O(^TMP("DILIST",$J,"ID",BPCX)) Q:BPCX=""  D

 .S BPCF="" F  S BPCF=$O(^TMP("DILIST",$J,"ID",BPCX,BPCF)) Q:BPCF=""  D

 ..S BPCDTA=BPCDTA_U_^TMP("DILIST",$J,"ID",BPCX,BPCF)

 S ^BGURES(BPCSUB,BPCCTR)=BPCDTA,BPCCTR=BPCCTR+1

NOK ;EP CALL FROM BPCLALL

 ;S BPCDTA=$G(^DPT(BPCIEN,".21")) I BPCDTA'="" S RESULT(BPCCTR)="NOK"_U_BPCDTA,BPCCTR=BPCCTR+1 Q

 S BPCDTA=$G(^DPT(BPCIEN,".21")) I BPCDTA'="" S ^BGURES(BPCSUB,BPCCTR)="NOK"_U_BPCDTA,BPCCTR=BPCCTR+1 Q

 S BPCDTA=$G(^DPT(BPCIEN,".24")) I BPCDTA'="" D NOK1 Q

 ;S RESULT(BPCCTR)="NOK"_U_"NO NEXT OF KIN SPECIFIED",BPCCTR=BPCCTR+1

 S ^BGURES(BPCSUB,BPCCTR)="NOK"_U_"NO NEXT OF KIN SPECIFIED",BPCCTR=BPCCTR+1

NOK1 ;

 S BPCFATH=$P(BPCDTA,U,1),BPCMOTH1=$P(BPCDTA,U,2),BPCMOTH2=$P(BPCDTA,U,3)

 ;I BPCFATH'="" S RESULT(BPCCTR)="NOK"_U_BPCFATH_U_"FATHER",BPCCTR=BPCCTR+1 Q

 I BPCFATH'="" S ^BGURES(BPCSUB,BPCCTR)="NOK"_U_BPCFATH_U_"FATHER",BPCCTR=BPCCTR+1 Q

 ;I BPCMOTH1'="" S RESULT(BPCCTR)="NOK"_U_BPCMOTH1_U_"MOTHER",BPCCTR=BPCCTR+1 Q

 I BPCMOTH1'="" S ^BGURES(BPCSUB,BPCCTR)="NOK"_U_BPCMOTH1_U_"MOTHER",BPCCTR=BPCCTR+1 Q

 ;I BPCMOTH2'="" S RESULT(BPCCTR)="NOK"_U_BPCMOTH2_U_"MOTHER (MAIDEN NAME)",BPCCTR=BPCCTR+1 Q

 I BPCMOTH2'="" S ^BGURES(BPCSUB,BPCCTR)="NOK"_U_BPCMOTH2_U_"MOTHER (MAIDEN NAME)",BPCCTR=BPCCTR+1 Q

 ;S RESULT(BPCCTR)="NOK"_U_"NO NEXT OF KIN SPECIFIED",BPCCTR=BPCCTR+1

 S ^BGURES(BPCSUB,BPCCTR)="NOK"_U_"NO NEXT OF KIN SPECIFIED",BPCCTR=BPCCTR+1

BPCLALL1  ; IHS/OIT/MJL - CONT BPCLALL LOAD INIT DATA PAT CHART ;

 +1       ;;1.5;BPC;;MAY 26, 2005

 +2       ;

MEAS      ;EP CALL FROM BPCPC

 +1        SET BPCCN1=0

           SET BPCY=""

FOR

               SET BPCY=$ORDER(^AUPNVMSR("AD",BPCVSIT,BPCY))

               IF BPCY=""

                   QUIT

               Begin DoDot:1

 +2                SET BPCCN1=BPCCN1+1

 +3                SET BPCMDTA=$GET(^AUPNVMSR(BPCY,0))

                   SET BPCVDTA=$GET(^AUPNVSIT(BPCVSIT,0))

                   SET BPCVDATE=$PIECE(BPCVDTA,U,1)

 +4                SET BPCTYP=$PIECE(BPCMDTA,U,1)

                   SET BPCMDESC=$PIECE($GET(^AUTTMSR(BPCTYP,0)),U,2)

 +5                SET BPCVAL=$PIECE(BPCMDTA,U,4)

 +6       ;FHL 8/4/98 ADDED MEASUREMENT IEN (BPCY) TO STRING

                   SET ^BGUTMP(BPCSUB,BPCX,"MEAS",BPCMDESC,BPCCN1)=BPCVDATE_U_"MEAS"_U_BPCMDESC_U_BPCVAL_U_BPCY

               End DoDot:1

 +7        QUIT

SITEP     ;EP CALL FROM BPVLALL

 +1        IF '$DATA(^BLRSITE("B",DUZ(2)))

               SET ^BGURES(BPCSUB,BPCCTR)="SITEP^"

               SET BPCCTR=BPCCTR+1

               QUIT

 +2        SET BPCIEN=$ORDER(^BLRSITE("B",DUZ(2),""))

           SET BPCIEN="`"_BPCIEN

           SET BPCFILE=9009029

 +3        SET BPCFLDS="1101;1102;1103;1104;1105"

 +4        DO FIND^DIC(BPCFILE,"",BPCFLDS,"",BPCIEN)

 +5        SET BPCDTA="SITEP"

 +6        SET BPCX=""

FOR

               SET BPCX=$ORDER(^TMP("DILIST",$JOB,"ID",BPCX))

               IF BPCX=""

                   QUIT

               Begin DoDot:1

 +7                SET BPCF=""

FOR

                       SET BPCF=$ORDER(^TMP("DILIST",$JOB,"ID",BPCX,BPCF))

                       IF BPCF=""

                           QUIT

                       Begin DoDot:2

 +8                        SET BPCDTA=BPCDTA_U_^TMP("DILIST",$JOB,"ID",BPCX,BPCF)

                       End DoDot:2

               End DoDot:1

 +9        SET ^BGURES(BPCSUB,BPCCTR)=BPCDTA

           SET BPCCTR=BPCCTR+1

 +10       QUIT

NOK       ;EP CALL FROM BPCLALL

 +1       ;S BPCDTA=$G(^DPT(BPCIEN,".21")) I BPCDTA'="" S RESULT(BPCCTR)="NOK"_U_BPCDTA,BPCCTR=BPCCTR+1 Q

 +2        SET BPCDTA=$GET(^DPT(BPCIEN,".21"))

           IF BPCDTA'=""

               SET ^BGURES(BPCSUB,BPCCTR)="NOK"_U_BPCDTA

               SET BPCCTR=BPCCTR+1

               QUIT

 +3        SET BPCDTA=$GET(^DPT(BPCIEN,".24"))

           IF BPCDTA'=""

               DO NOK1

               QUIT

 +4       ;S RESULT(BPCCTR)="NOK"_U_"NO NEXT OF KIN SPECIFIED",BPCCTR=BPCCTR+1

 +5        SET ^BGURES(BPCSUB,BPCCTR)="NOK"_U_"NO NEXT OF KIN SPECIFIED"

           SET BPCCTR=BPCCTR+1

 +6        QUIT

NOK1      ;

 +1        SET BPCFATH=$PIECE(BPCDTA,U,1)

           SET BPCMOTH1=$PIECE(BPCDTA,U,2)

           SET BPCMOTH2=$PIECE(BPCDTA,U,3)

 +2       ;I BPCFATH'="" S RESULT(BPCCTR)="NOK"_U_BPCFATH_U_"FATHER",BPCCTR=BPCCTR+1 Q

 +3        IF BPCFATH'=""

               SET ^BGURES(BPCSUB,BPCCTR)="NOK"_U_BPCFATH_U_"FATHER"

               SET BPCCTR=BPCCTR+1

               QUIT

 +4       ;I BPCMOTH1'="" S RESULT(BPCCTR)="NOK"_U_BPCMOTH1_U_"MOTHER",BPCCTR=BPCCTR+1 Q

 +5        IF BPCMOTH1'=""

               SET ^BGURES(BPCSUB,BPCCTR)="NOK"_U_BPCMOTH1_U_"MOTHER"

               SET BPCCTR=BPCCTR+1

               QUIT

 +6       ;I BPCMOTH2'="" S RESULT(BPCCTR)="NOK"_U_BPCMOTH2_U_"MOTHER (MAIDEN NAME)",BPCCTR=BPCCTR+1 Q

 +7        IF BPCMOTH2'=""

               SET ^BGURES(BPCSUB,BPCCTR)="NOK"_U_BPCMOTH2_U_"MOTHER (MAIDEN NAME)"

               SET BPCCTR=BPCCTR+1

               QUIT

 +8       ;S RESULT(BPCCTR)="NOK"_U_"NO NEXT OF KIN SPECIFIED",BPCCTR=BPCCTR+1

 +9        SET ^BGURES(BPCSUB,BPCCTR)="NOK"_U_"NO NEXT OF KIN SPECIFIED"

           SET BPCCTR=BPCCTR+1

 +10       QUIT

BPCLALL1.m