- BPCLALL ; IHS/OIT/MJL - PCC VISIT LIST FOR GUI ;
- ;;1.5;BPC;;MAY 26, 2005
- ;GETS PCC VISIT DATA
- EN ;ENTRY POINT
- S U="^",BPCLIM=20,BPCSUB=$J K ^BGUTMP($J),RESULT,^BGURES($J)
- S RESULT="^BGURES("_BPCSUB_")"
- I '$D(BPCIEN) S ^BGURES(BPCSUB,1)=-1,^BGURES(BPCSUB,2)="NO Lab internal entry found! (BPCIEN)" Q
- ;I '$D(BPCIEN) S RESULT(1)=-1,RESULT(2)="NO Lab internal entry found! (BPCIEN)" Q
- S X=0,BPCCNT=0 F I=1:1:BPCLIM S X=$O(^AUPNVSIT("AA",BPCIEN,X)) Q:+X=0 S BPCVSIT="" F S BPCVSIT=$O(^AUPNVSIT("AA",BPCIEN,X,BPCVSIT)) Q:BPCVSIT="" D VISIT
- S X=0,BPCCTR=2 F S X=$O(^BGUTMP($J,X)) Q:+X=0 S Y="" F S Y=$O(^BGUTMP($J,X,Y)) Q:Y="" S Z="" F S Z=$O(^BGUTMP($J,X,Y,Z)) Q:Z="" S ^BGURES(BPCSUB,BPCCTR)=^BGUTMP($J,X,Y,Z),BPCCTR=BPCCTR+1
- D TRENDS,ALERTS,REMARKS,NOK,SITEP
- S ^BGURES(BPCSUB,1)=BPCCTR-1
- K BPCCTR,^BGUTMP($J),BPCV
- Q
- ;
- VISIT ;
- S BPCV=$G(BPCV)+1
- S Y=^AUPNVSIT(BPCVSIT,0),BPCVDT=$P(Y,U,1),BPCLOC=$P(Y,U,6),BPCSC=$P(Y,U,7),BPCCLIN=$P(Y,U,8)
- I $L(BPCLOC) S BPCLOC=$G(^AUTTLOC(BPCLOC,0)) S:$L(BPCLOC) BPCLOC=$P(BPCLOC,U,2)
- I $L(BPCCLIN) S BPCCLIN=$G(^DIC(40.7,BPCCLIN,0)) S:$L(BPCCLIN) BPCCLIN=$P(BPCCLIN,U,1)
- S X1=0 F S X1=$O(^AUPNVPRV("AD",BPCVSIT,X1)) Q:+X1=0 D
- . Q:'$D(^AUPNVPRV(X1,0))
- . Q:$P(^AUPNVPRV(X1,0),U,4)'="P"
- . S BPCPRV=$P(X1,U,1),BPCPRV=$P($G(^VA(200,BPCPRV,0)),U,1) S:'$L(BPCPRV) BPCPRV=X1
- S ^BGUTMP($J,X,"VISIT","NONE")=BPCVDT_U_"VISIT"_U_BPCVSIT_U_BPCLOC_U_$G(BPCPRV)_U_BPCSC_U_BPCCLIN D LAB,POV,MED
- S BPCFLG="" S:$D(^BGUTMP($J,X,"LAB")) BPCFLG="L" S:$D(^BGUTMP($J,X,"POV")) BPCFLG=BPCFLG_"P" S:$D(^BGUTMP($J,X,"MED")) BPCFLG=BPCFLG_"M" S $P(^BGUTMP($J,X,"VISIT","NONE"),U,6)=BPCFLG
- Q
- ;
- VST2 ;
- Q:$P(^AUPNVPRV(X1,0),U,4)'="P"
- S BPCPRV=$P(X1,U,1),BPCPRV=$P($G(^VA(200,BPCPRV,0)),U,1) S:'$L(BPCPRV) BPCPRV=X1
- Q
- ;
- LAB ;
- S X1=0 F S X1=$O(^AUPNVLAB("AD",BPCVSIT,X1)) Q:+X1=0 D
- . Q:'$D(^AUPNVLAB(X1,0))
- . S Y=^AUPNVLAB(X1,0),Y11=$G(^AUPNVLAB(X1,11)),Y12=$G(^AUPNVLAB(X1,12))
- . S BPCTEST=$P(Y,U,1),BPCTEST=$P($G(^LAB(60,BPCTEST,0)),U,1) Q:'$L(BPCTEST)
- . S BPCVALUE=$P(Y,U,4),BPCFLAGL=$P(Y,U,5),BPCREFL=$P(Y11,U,4),BPCREFH=$P(Y11,U,5),BPCUNITS=$P(Y11,U,1)
- . S BPCSITE="" I $L($P(Y11,U,3)) S BPCSITE=$P(Y11,U,3),BPCSITE=$S(BPCSITE=72:70,BPCSITE=73:BPCSITE=70,1:BPCSITE),BPCSITE=$P($G(^LAB(61,BPCSITE,0)),U,1)
- . S BPCCTR(BPCTEST)=$G(BPCCTR(BPCTEST))+1
- . S BPCCDT=$P(Y12,U,1) S:BPCCDT="" BPCCDT=BPCVDT
- . S BPCTEST1=BPCTEST,BPCCNT=BPCCNT+1
- . I $D(^BGUTMP($J,X,"LAB",BPCTEST)) S BPCTEST1=BPCTEST_BPCCNT
- . S ^BGUTMP($J,X,"LAB",BPCTEST1)=BPCVDT_U_"LAB"_U_BPCTEST_U_X1_U_BPCVALUE_U_BPCFLAGL_U_BPCUNITS_U_BPCREFL_U_BPCREFH_U_BPCSITE_U_BPCCDT
- Q
- ;
- MED S X1=0 F S X1=$O(^AUPNVMED("AD",BPCVSIT,X1)) Q:+X1=0 D
- . Q:'$D(^AUPNVMED(X1,0))
- . S Y=^AUPNVMED(X1,0),Y12=$G(^AUPNVMED(X1,12))
- . S BPCMED=$P(Y,U,1),BPCMED=$P($G(^PSDRUG(BPCMED,0)),U,1) Q:'$L(BPCMED)
- . S BPCDNAM=$P(Y,U,4),BPCSIG=$P(Y,U,5),BPCQTY=$P(Y,U,6),BPCDAYS=$P(Y,U,7),BPCDDAY=$P(Y,U,8)
- . S BPCCDT=$P(Y12,U,1) S:BPCCDT="" BPCCDT=BPCVDT
- . S ^BGUTMP($J,X,"MED",BPCMED)=BPCVDT_U_"MED"_U_BPCMED_U_X1_U_BPCDNAM_U_BPCSIG_U_BPCQTY_U_BPCDAYS_U_BPCCDT
- Q
- ;
- POV S X1=0 F S X1=$O(^AUPNVPOV("AD",BPCVSIT,X1)) Q:+X1=0 D
- . Q:'$D(^AUPNVPOV(X1,0))
- . S BPCDTA=$G(^AUPNVPOV(X1,0))
- . S Y=$P(BPCDTA,U,1) Q:'$L(Y)
- . S BPCPOV=$P($G(^ICD9(Y,0)),U,3)
- . S Y=$P(BPCDTA,U,4) Q:'$L(Y)
- . S BPCNAR=$G(^AUTNPOV(Y,0))
- . S ^BGUTMP($J,X,"POV",X1)=BPCVDT_U_"POV"_U_BPCPOV_U_BPCNAR_U_X1
- Q
- ;
- TRENDS ;EP ADD TEST COUNTS FOR TRENDING TO RESULT ARRAY FROM BPCPC
- ;S BPCTEST="" F S BPCTEST=$O(BPCCTR(BPCTEST)) Q:BPCTEST="" S RESULT(BPCCTR)="TREND"_U_BPCTEST_U_BPCCTR(BPCTEST),BPCCTR=BPCCTR+1
- S BPCTEST="" F S BPCTEST=$O(BPCCTR(BPCTEST)) Q:BPCTEST="" S ^BGURES(BPCSUB,BPCCTR)="TREND"_U_BPCTEST_U_BPCCTR(BPCTEST),BPCCTR=BPCCTR+1
- Q
- ALERTS ;EP ADD ALERT DATA FROM BPCPC
- ;I '$D(^AUPNPAT(BPCIEN,15)) S RESULT(BPCCTR)="ALERT"_U_"NO ALERTS",BPCCTR=BPCCTR+1 Q
- I '$D(^AUPNPAT(BPCIEN,15)) S ^BGURES(BPCSUB,BPCCTR)="ALERT"_U_"NO ALERTS",BPCCTR=BPCCTR+1 Q
- ;S BPCX="",BPCFLG=0 F S BPCX=$O(^AUPNPAT(BPCIEN,15,BPCX)) Q:BPCX="" S BPCDTA=$G(^AUPNPAT(BPCIEN,15,BPCX,0)) I BPCDTA'="" S RESULT(BPCCTR)="ALERT"_U_BPCDTA,BPCCTR=BPCCTR+1,BPCFLG=1
- S BPCX="",BPCFLG=0 F S BPCX=$O(^AUPNPAT(BPCIEN,15,BPCX)) Q:BPCX="" S BPCDTA=$G(^AUPNPAT(BPCIEN,15,BPCX,0)) I BPCDTA'="" S ^BGURES(BPCSUB,BPCCTR)="ALERT"_U_BPCDTA,BPCCTR=BPCCTR+1,BPCFLG=1
- ;I 'BPCFLG S RESULT(BPCCTR)="ALERT"_U_"NO ALERTS",BPCCTR=BPCCTR+1
- I 'BPCFLG S ^BGURES(BPCSUB,BPCCTR)="ALERT"_U_"NO ALERTS",BPCCTR=BPCCTR+1
- Q
- ;I '$D(^AUPNPAT(BPCIEN,14)) S RESULT(BPCCTR)="REMARK"_U_"NO REMARKS",BPCCTR=BPCCTR+1 Q
- I '$D(^AUPNPAT(BPCIEN,14)) S ^BGURES(BPCSUB,BPCCTR)="REMARK"_U_"NO REMARKS",BPCCTR=BPCCTR+1 Q
- ;S BPCX="",BPCFLG=0 F S BPCX=$O(^AUPNPAT(BPCIEN,14,BPCX)) Q:BPCX="" S BPCDTA=$G(^AUPNPAT(BPCIEN,14,BPCX,0)) I BPCDTA'="" S RESULT(BPCCTR)="REMARK"_U_BPCDTA,BPCCTR=BPCCTR+1,BPCFLG=1
- S BPCX="",BPCFLG=0 F S BPCX=$O(^AUPNPAT(BPCIEN,14,BPCX)) Q:BPCX="" S BPCDTA=$G(^AUPNPAT(BPCIEN,14,BPCX,0)) I BPCDTA'="" S ^BGURES(BPCSUB,BPCCTR)="REMARK"_U_BPCDTA,BPCCTR=BPCCTR+1,BPCFLG=1
- ;I 'BPCFLG S RESULT(BPCCTR)="REMARK"_U_"NO REMARKS",BPCCTR=BPCCTR+1
- I 'BPCFLG S ^BGURES(BPCSUB,BPCCTR)="REMARK"_U_"NO REMARKS",BPCCTR=BPCCTR+1
- Q
- NOK ; ADD NEXT OF KIN DATA
- D NOK^BPCLALL1
- Q
- SITEP ;
- D SITEP^BPCLALL1
- Q
- BPCLALL ; IHS/OIT/MJL - PCC VISIT LIST FOR GUI ;
- +1 ;;1.5;BPC;;MAY 26, 2005
- +2 ;GETS PCC VISIT DATA
- EN ;ENTRY POINT
- +1 SET U="^"
- SET BPCLIM=20
- SET BPCSUB=$JOB
- KILL ^BGUTMP($JOB),RESULT,^BGURES($JOB)
- +2 SET RESULT="^BGURES("_BPCSUB_")"
- +3 IF '$DATA(BPCIEN)
- SET ^BGURES(BPCSUB,1)=-1
- SET ^BGURES(BPCSUB,2)="NO Lab internal entry found! (BPCIEN)"
- QUIT
- +4 ;I '$D(BPCIEN) S RESULT(1)=-1,RESULT(2)="NO Lab internal entry found! (BPCIEN)" Q
- +5 SET X=0
- SET BPCCNT=0
- FOR I=1:1:BPCLIM
- SET X=$ORDER(^AUPNVSIT("AA",BPCIEN,X))
- IF +X=0
- QUIT
- SET BPCVSIT=""
- FOR
- SET BPCVSIT=$ORDER(^AUPNVSIT("AA",BPCIEN,X,BPCVSIT))
- IF BPCVSIT=""
- QUIT
- DO VISIT
- +6 SET X=0
- SET BPCCTR=2
- FOR
- SET X=$ORDER(^BGUTMP($JOB,X))
- IF +X=0
- QUIT
- SET Y=""
- FOR
- SET Y=$ORDER(^BGUTMP($JOB,X,Y))
- IF Y=""
- QUIT
- SET Z=""
- FOR
- SET Z=$ORDER(^BGUTMP($JOB,X,Y,Z))
- IF Z=""
- QUIT
- SET ^BGURES(BPCSUB,BPCCTR)=^BGUTMP($JOB,X,Y,Z)
- SET BPCCTR=BPCCTR+1
- +7 DO TRENDS
- DO ALERTS
- DO REMARKS
- DO NOK
- DO SITEP
- +8 SET ^BGURES(BPCSUB,1)=BPCCTR-1
- +9 KILL BPCCTR,^BGUTMP($JOB),BPCV
- +10 QUIT
- +11 ;
- VISIT ;
- +1 SET BPCV=$GET(BPCV)+1
- +2 SET Y=^AUPNVSIT(BPCVSIT,0)
- SET BPCVDT=$PIECE(Y,U,1)
- SET BPCLOC=$PIECE(Y,U,6)
- SET BPCSC=$PIECE(Y,U,7)
- SET BPCCLIN=$PIECE(Y,U,8)
- +3 IF $LENGTH(BPCLOC)
- SET BPCLOC=$GET(^AUTTLOC(BPCLOC,0))
- IF $LENGTH(BPCLOC)
- SET BPCLOC=$PIECE(BPCLOC,U,2)
- +4 IF $LENGTH(BPCCLIN)
- SET BPCCLIN=$GET(^DIC(40.7,BPCCLIN,0))
- IF $LENGTH(BPCCLIN)
- SET BPCCLIN=$PIECE(BPCCLIN,U,1)
- +5 SET X1=0
- FOR
- SET X1=$ORDER(^AUPNVPRV("AD",BPCVSIT,X1))
- IF +X1=0
- QUIT
- Begin DoDot:1
- +6 IF '$DATA(^AUPNVPRV(X1,0))
- QUIT
- +7 IF $PIECE(^AUPNVPRV(X1,0),U,4)'="P"
- QUIT
- +8 SET BPCPRV=$PIECE(X1,U,1)
- SET BPCPRV=$PIECE($GET(^VA(200,BPCPRV,0)),U,1)
- IF '$LENGTH(BPCPRV)
- SET BPCPRV=X1
- End DoDot:1
- +9 SET ^BGUTMP($JOB,X,"VISIT","NONE")=BPCVDT_U_"VISIT"_U_BPCVSIT_U_BPCLOC_U_$GET(BPCPRV)_U_BPCSC_U_BPCCLIN
- DO LAB
- DO POV
- DO MED
- +10 SET BPCFLG=""
- IF $DATA(^BGUTMP($JOB,X,"LAB"))
- SET BPCFLG="L"
- IF $DATA(^BGUTMP($JOB,X,"POV"))
- SET BPCFLG=BPCFLG_"P"
- IF $DATA(^BGUTMP($JOB,X,"MED"))
- SET BPCFLG=BPCFLG_"M"
- SET $PIECE(^BGUTMP($JOB,X,"VISIT","NONE"),U,6)=BPCFLG
- +11 QUIT
- +12 ;
- VST2 ;
- +1 IF $PIECE(^AUPNVPRV(X1,0),U,4)'="P"
- QUIT
- +2 SET BPCPRV=$PIECE(X1,U,1)
- SET BPCPRV=$PIECE($GET(^VA(200,BPCPRV,0)),U,1)
- IF '$LENGTH(BPCPRV)
- SET BPCPRV=X1
- +3 QUIT
- +4 ;
- LAB ;
- +1 SET X1=0
- FOR
- SET X1=$ORDER(^AUPNVLAB("AD",BPCVSIT,X1))
- IF +X1=0
- QUIT
- Begin DoDot:1
- +2 IF '$DATA(^AUPNVLAB(X1,0))
- QUIT
- +3 SET Y=^AUPNVLAB(X1,0)
- SET Y11=$GET(^AUPNVLAB(X1,11))
- SET Y12=$GET(^AUPNVLAB(X1,12))
- +4 SET BPCTEST=$PIECE(Y,U,1)
- SET BPCTEST=$PIECE($GET(^LAB(60,BPCTEST,0)),U,1)
- IF '$LENGTH(BPCTEST)
- QUIT
- +5 SET BPCVALUE=$PIECE(Y,U,4)
- SET BPCFLAGL=$PIECE(Y,U,5)
- SET BPCREFL=$PIECE(Y11,U,4)
- SET BPCREFH=$PIECE(Y11,U,5)
- SET BPCUNITS=$PIECE(Y11,U,1)
- +6 SET BPCSITE=""
- IF $LENGTH($PIECE(Y11,U,3))
- SET BPCSITE=$PIECE(Y11,U,3)
- SET BPCSITE=$SELECT(BPCSITE=72:70,BPCSITE=73:BPCSITE=70,1:BPCSITE)
- SET BPCSITE=$PIECE($GET(^LAB(61,BPCSITE,0)),U,1)
- +7 SET BPCCTR(BPCTEST)=$GET(BPCCTR(BPCTEST))+1
- +8 SET BPCCDT=$PIECE(Y12,U,1)
- IF BPCCDT=""
- SET BPCCDT=BPCVDT
- +9 SET BPCTEST1=BPCTEST
- SET BPCCNT=BPCCNT+1
- +10 IF $DATA(^BGUTMP($JOB,X,"LAB",BPCTEST))
- SET BPCTEST1=BPCTEST_BPCCNT
- +11 SET ^BGUTMP($JOB,X,"LAB",BPCTEST1)=BPCVDT_U_"LAB"_U_BPCTEST_U_X1_U_BPCVALUE_U_BPCFLAGL_U_BPCUNITS_U_BPCREFL_U_BPCREFH_U_BPCSITE_U_BPCCDT
- End DoDot:1
- +12 QUIT
- +13 ;
- MED SET X1=0
- FOR
- SET X1=$ORDER(^AUPNVMED("AD",BPCVSIT,X1))
- IF +X1=0
- QUIT
- Begin DoDot:1
- +1 IF '$DATA(^AUPNVMED(X1,0))
- QUIT
- +2 SET Y=^AUPNVMED(X1,0)
- SET Y12=$GET(^AUPNVMED(X1,12))
- +3 SET BPCMED=$PIECE(Y,U,1)
- SET BPCMED=$PIECE($GET(^PSDRUG(BPCMED,0)),U,1)
- IF '$LENGTH(BPCMED)
- QUIT
- +4 SET BPCDNAM=$PIECE(Y,U,4)
- SET BPCSIG=$PIECE(Y,U,5)
- SET BPCQTY=$PIECE(Y,U,6)
- SET BPCDAYS=$PIECE(Y,U,7)
- SET BPCDDAY=$PIECE(Y,U,8)
- +5 SET BPCCDT=$PIECE(Y12,U,1)
- IF BPCCDT=""
- SET BPCCDT=BPCVDT
- +6 SET ^BGUTMP($JOB,X,"MED",BPCMED)=BPCVDT_U_"MED"_U_BPCMED_U_X1_U_BPCDNAM_U_BPCSIG_U_BPCQTY_U_BPCDAYS_U_BPCCDT
- End DoDot:1
- +7 QUIT
- +8 ;
- POV SET X1=0
- FOR
- SET X1=$ORDER(^AUPNVPOV("AD",BPCVSIT,X1))
- IF +X1=0
- QUIT
- Begin DoDot:1
- +1 IF '$DATA(^AUPNVPOV(X1,0))
- QUIT
- +2 SET BPCDTA=$GET(^AUPNVPOV(X1,0))
- +3 SET Y=$PIECE(BPCDTA,U,1)
- IF '$LENGTH(Y)
- QUIT
- +4 SET BPCPOV=$PIECE($GET(^ICD9(Y,0)),U,3)
- +5 SET Y=$PIECE(BPCDTA,U,4)
- IF '$LENGTH(Y)
- QUIT
- +6 SET BPCNAR=$GET(^AUTNPOV(Y,0))
- +7 SET ^BGUTMP($JOB,X,"POV",X1)=BPCVDT_U_"POV"_U_BPCPOV_U_BPCNAR_U_X1
- End DoDot:1
- +8 QUIT
- +9 ;
- TRENDS ;EP ADD TEST COUNTS FOR TRENDING TO RESULT ARRAY FROM BPCPC
- +1 ;S BPCTEST="" F S BPCTEST=$O(BPCCTR(BPCTEST)) Q:BPCTEST="" S RESULT(BPCCTR)="TREND"_U_BPCTEST_U_BPCCTR(BPCTEST),BPCCTR=BPCCTR+1
- +2 SET BPCTEST=""
- FOR
- SET BPCTEST=$ORDER(BPCCTR(BPCTEST))
- IF BPCTEST=""
- QUIT
- SET ^BGURES(BPCSUB,BPCCTR)="TREND"_U_BPCTEST_U_BPCCTR(BPCTEST)
- SET BPCCTR=BPCCTR+1
- +3 QUIT
- ALERTS ;EP ADD ALERT DATA FROM BPCPC
- +1 ;I '$D(^AUPNPAT(BPCIEN,15)) S RESULT(BPCCTR)="ALERT"_U_"NO ALERTS",BPCCTR=BPCCTR+1 Q
- +2 IF '$DATA(^AUPNPAT(BPCIEN,15))
- SET ^BGURES(BPCSUB,BPCCTR)="ALERT"_U_"NO ALERTS"
- SET BPCCTR=BPCCTR+1
- QUIT
- +3 ;S BPCX="",BPCFLG=0 F S BPCX=$O(^AUPNPAT(BPCIEN,15,BPCX)) Q:BPCX="" S BPCDTA=$G(^AUPNPAT(BPCIEN,15,BPCX,0)) I BPCDTA'="" S RESULT(BPCCTR)="ALERT"_U_BPCDTA,BPCCTR=BPCCTR+1,BPCFLG=1
- +4 SET BPCX=""
- SET BPCFLG=0
- FOR
- SET BPCX=$ORDER(^AUPNPAT(BPCIEN,15,BPCX))
- IF BPCX=""
- QUIT
- SET BPCDTA=$GET(^AUPNPAT(BPCIEN,15,BPCX,0))
- IF BPCDTA'=""
- SET ^BGURES(BPCSUB,BPCCTR)="ALERT"_U_BPCDTA
- SET BPCCTR=BPCCTR+1
- SET BPCFLG=1
- +5 ;I 'BPCFLG S RESULT(BPCCTR)="ALERT"_U_"NO ALERTS",BPCCTR=BPCCTR+1
- +6 IF 'BPCFLG
- SET ^BGURES(BPCSUB,BPCCTR)="ALERT"_U_"NO ALERTS"
- SET BPCCTR=BPCCTR+1
- +7 QUIT
- +1 ;I '$D(^AUPNPAT(BPCIEN,14)) S RESULT(BPCCTR)="REMARK"_U_"NO REMARKS",BPCCTR=BPCCTR+1 Q
- +2 IF '$DATA(^AUPNPAT(BPCIEN,14))
- SET ^BGURES(BPCSUB,BPCCTR)="REMARK"_U_"NO REMARKS"
- SET BPCCTR=BPCCTR+1
- QUIT
- +3 ;S BPCX="",BPCFLG=0 F S BPCX=$O(^AUPNPAT(BPCIEN,14,BPCX)) Q:BPCX="" S BPCDTA=$G(^AUPNPAT(BPCIEN,14,BPCX,0)) I BPCDTA'="" S RESULT(BPCCTR)="REMARK"_U_BPCDTA,BPCCTR=BPCCTR+1,BPCFLG=1
- +4 SET BPCX=""
- SET BPCFLG=0
- FOR
- SET BPCX=$ORDER(^AUPNPAT(BPCIEN,14,BPCX))
- IF BPCX=""
- QUIT
- SET BPCDTA=$GET(^AUPNPAT(BPCIEN,14,BPCX,0))
- IF BPCDTA'=""
- SET ^BGURES(BPCSUB,BPCCTR)="REMARK"_U_BPCDTA
- SET BPCCTR=BPCCTR+1
- SET BPCFLG=1
- +5 ;I 'BPCFLG S RESULT(BPCCTR)="REMARK"_U_"NO REMARKS",BPCCTR=BPCCTR+1
- +6 IF 'BPCFLG
- SET ^BGURES(BPCSUB,BPCCTR)="REMARK"_U_"NO REMARKS"
- SET BPCCTR=BPCCTR+1
- +7 QUIT
- NOK ; ADD NEXT OF KIN DATA
- +1 DO NOK^BPCLALL1
- +2 QUIT
- SITEP ;
- +1 DO SITEP^BPCLALL1
- +2 QUIT
