APCLBP1 ; IHS/CMI/LAB - CALC WEIGHT REPORT ;
;;2.0;IHS PCC SUITE;**4,15**;MAY 14, 2009;Build 11
;
; APCLBTYP - blood pressure type measurement (4)
; APCLOCTL - Blood pressure out of control flag
START ;
S APCLBTYP=$O(^AUTTMSR("B","BP",0))
S Y=DT D DD^%DT S APCLDT=Y
S APCLJOB=$J,APCLBTH=$H,APCLPTOT=0,APCLTPOC=0
D XTMP^APCLOSUT("APCLBP","PCC BLOOD PRESSURE - OUT OF CONTROL - REPORT")
; If Search Template used
I APCLSEAT'="" D Q
.S DFN=0 F S DFN=$O(^DIBT(APCLSEAT,1,DFN)) Q:'DFN I $D(^DPT(DFN,0)),'$P(^DPT(DFN,0),U,19) D PROC
S DFN=0 F S DFN=$O(^AUPNPAT(DFN)) Q:'DFN I $D(^DPT(DFN,0)),'$P(^DPT(DFN,0),U,19) D PROC
D KILL
Q
;
PROC ;
Q:$$DEMO^APCLUTL(DFN,$G(APCLDEMO))
S Y=DFN D ^AUPNPAT
Q:AUPNSEX=""
I APCLSEX'="B",APCLSEX'=AUPNSEX Q ;quit if want only one sex and this patient isn't that sex
;
; Quit if communities are selected and the patient's community is blank
; or the patient's community is not one of the ones selected
;
S APCLCMTY=$$COMMRES^AUPNPAT(DFN,"E") S:"-1"[APCLCMTY APCLCMTY=$P($G(^AUPNPAT(DFN,11)),U,18)
I $D(APCLCOMM) Q:APCLCMTY="" Q:'$D(APCLCOMM(APCLCMTY))
S:APCLCMTY="" APCLCMTY="~UNKNOWN" ; the ~ puts it last in the sort
; Quit if no birth date
Q:AUPNDOB=""
S APCLAGE=(AUPNDAYS\365.25)
S APCLCLAS=$$BEN^AUPNPAT(DFN,"C") ; returns classifications/beneficiary in format F
Q:APCLCLAS=""
I APCLIBEN=1,APCLCLAS'="01" Q
S X1=DT,X2=AUPNDOB D ^%DTC S APCLAGE=(X\365.25) ;recalculate age based on date of weight
I $D(APCLAGER) Q:APCLAGE<$P(APCLAGER,"-") Q:APCLAGE>$P(APCLAGER,"-",2)
;
; APCLOCTL - Blood pressure out of control flag
;
S (APCLOCTL,APCLTSBP,APCLTDBP,APCLBPC)=0
S APCLDT=APCLED-1 F S APCLDT=$O(^AUPNVMSR("AA",DFN,APCLBTYP,APCLDT)) Q:'APCLDT Q:APCLDT>APCLSD D
.S APCLMIEN=0 F S APCLMIEN=$O(^AUPNVMSR("AA",DFN,APCLBTYP,APCLDT,APCLMIEN)) Q:'APCLMIEN D:$D(^AUPNVMSR(APCLMIEN))
..Q:$P($G(^AUPNVMSR(APCLMIEN,2)),U,1) ;entered in error
..S APCLVSIT=$P(^AUPNVMSR(APCLMIEN,0),U,3),APCLCLIN=$P(^AUPNVSIT(APCLVSIT,0),U,8)
..I $D(APCLCLNT) Q:APCLCLIN="" Q:'$D(APCLCLNT(APCLCLIN))
..S APCLVCLN=APCLCLIN,APCLBPC=APCLBPC+1,APCLSBP=$P(^AUPNVMSR(APCLMIEN,0),U,4),APCLDBP=$P(APCLSBP,"/",2),APCLSBP=+APCLSBP,APCLTSBP=APCLTSBP+APCLSBP,APCLTDBP=APCLTDBP+APCLDBP
;
; If blood pressure count (APCLPBC) > 0 then the patient meets the selection criteria
; APCLPTOT - Total patients that were checked
; APCLTPOC - Total patients with BP out of control
; APCLTOCTL blood pressure out of control flag
; = 1 or 11 Systolic out of control (#10>0)
; = 10 or 11 Diastolic out of control (> 1)
D:APCLBPC
.S APCLOCTL=0,APCLMSBP=APCLTSBP\APCLBPC
.S:APCLMSBP>139 APCLOCTL=1
.I APCLRTYP="S" S APCLBPTY=1,APCLSORT=APCLCMTY,APCLTBP=APCLTSBP D COUNT1 S APCLSORT=0 D COUNT1
.S APCLMDBP=APCLTDBP\APCLBPC S:APCLMDBP>89 APCLOCTL=APCLOCTL+10
.I APCLOCTL,APCLRTYP="C" S ^DIBT(APCLSTMP,1,DFN)="" Q
.I APCLRTYP="S" S APCLBPTY=2,APCLSORT=APCLCMTY,APCLTBP=APCLTDBP D COUNT1 S APCLSORT=0 D COUNT1
Q:APCLRTYP="C"
D
.;If the report type is Detail save patient data and B/P readings only,
.; otherwise collect summary statistics data
.;
.I APCLRTYP="D" D:APCLOCTL SET Q
.S APCLSORT=APCLCMTY D COUNT ; do count for community
.S APCLSORT=0 D COUNT ; do count for total
Q
;
; APCLSORT - is the community name, it's set to zero when summing stats
; for the grand total
;
; stored at the APCLSORT level:
;Piece
; 1 APCLCPT - Patient count
; 2 APCLCBC - count of blood pressures taken
; APCLTYP = 1 used to store systolic values
; = 2 used to store diastolic values
; Pieces stored at this level pertaining to the specific type
; 1 Sum total of values of blood pressure readings
; 2 total out of countrol patients
; 3 total out of control counts of B/P
; 4 Sum total of values of blood pressures readings for
; out of control blood pressures
;
; Used for setting data for the statistical summary report
COUNT ;
S APCLPTOT=APCLPTOT+1
S APCLX=$G(^XTMP("APCLBP",APCLJOB,APCLBTH,"STATS",APCLSORT))
S APCLCPT=$P(APCLX,U)+1,APCLTOPT=$P(APCLX,U,2)+(APCLOCTL>0),APCLCBC=$P(APCLX,U,3)+APCLBPC
S ^XTMP("APCLBP",APCLJOB,APCLBTH,"STATS",APCLSORT)=APCLCPT_U_APCLTOPT_U_APCLCBC
Q
;
COUNT1 ;
S APCLX=$G(^XTMP("APCLBP",APCLJOB,APCLBTH,"STATS",APCLSORT,APCLBPTY))
S APCLCTB=$P(APCLX,U,1)+APCLTBP,APCLTOP=$P(APCLX,U,2),APCLTOBC=$P(APCLX,U,3),APCLTOBP=$P(APCLX,U,4)
I APCLOCTL,$S(APCLBPTY=1:APCLOCTL#10,1:APCLOCTL>1) S APCLTOP=APCLTOP+1,APCLTOBC=APCLTOBC+APCLBPC,APCLTOBP=APCLTOBP+APCLTBP
S ^XTMP("APCLBP",APCLJOB,APCLBTH,"STATS",APCLSORT,APCLBPTY)=APCLCTB_U_APCLTOP_U_APCLTOBC_U_APCLTOBP
Q
;
; Collects data for the detail report
SET ;
S APCLPTOT=APCLPTOT+1
S APCLNAME=$P(^DPT(DFN,0),U)
S APCLHRN=$S($D(^AUPNPAT(DFN,41,DUZ(2),0)):$P(^(0),U,2),1:"NONE")
; If sort is neither Patient or Age then the report type must be
; Summary, not Detail, therefore community will be used for the sort
S APCLSRT=$S(APCLSORT="P":APCLNAME,APCLSORT="A":APCLAGE,1:APCLCMTY)
S:APCLVCLN'="" APCLVCLN=$P(^DIC(40.7,APCLVCLN,0),U,1)
S ^XTMP("APCLBP",APCLJOB,APCLBTH,"PATS",APCLSRT,DFN)=APCLNAME_U_APCLHRN_U_APCLAGE_U_AUPNSEX_U_APCLCMTY_U_APCLVCLN_U_APCLBPC_U_$J(APCLMSBP,3)_"/"_APCLMDBP
Q
;
KILL ;
K APCLAGE,APCLBPC,APCLBPTY,APCLBTYP,APCLCBC,APCLCLAS,APCLCMTY,APCLCPT,APCLCTB,APCLDT,APCLGRAN,APCLHRN,APCLMBP,APCLMDBP,APCLMIEN,APCLMSBP,APCLNAME,APCLOCTL,APCLSORT,APCLSRT,APCLTBP
K APCLTDBP,APCLTOBC,APCLTOBP,APCLTOP,APCLTOPT,APCLTPOC,APCLTSBP,APCLVCLN,APCLX,DFN,X1,X2,Y
D KILL^AUPNPAT
Q
APCLBP1 ; IHS/CMI/LAB - CALC WEIGHT REPORT ;
+1 ;;2.0;IHS PCC SUITE;**4,15**;MAY 14, 2009;Build 11
+2 ;
+3 ; APCLBTYP - blood pressure type measurement (4)
+4 ; APCLOCTL - Blood pressure out of control flag
START ;
+1 SET APCLBTYP=$ORDER(^AUTTMSR("B","BP",0))
+2 SET Y=DT
DO DD^%DT
SET APCLDT=Y
+3 SET APCLJOB=$JOB
SET APCLBTH=$HOROLOG
SET APCLPTOT=0
SET APCLTPOC=0
+4 DO XTMP^APCLOSUT("APCLBP","PCC BLOOD PRESSURE - OUT OF CONTROL - REPORT")
+5 ; If Search Template used
+6 IF APCLSEAT'=""
Begin DoDot:1
+7 SET DFN=0
FOR
SET DFN=$ORDER(^DIBT(APCLSEAT,1,DFN))
IF 'DFN
QUIT
IF $DATA(^DPT(DFN,0))
IF '$PIECE(^DPT(DFN,0),U,19)
DO PROC
End DoDot:1
QUIT
+8 SET DFN=0
FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF 'DFN
QUIT
IF $DATA(^DPT(DFN,0))
IF '$PIECE(^DPT(DFN,0),U,19)
DO PROC
+9 DO KILL
+10 QUIT
+11 ;
PROC ;
+1 IF $$DEMO^APCLUTL(DFN,$GET(APCLDEMO))
QUIT
+2 SET Y=DFN
DO ^AUPNPAT
+3 IF AUPNSEX=""
QUIT
+4 ;quit if want only one sex and this patient isn't that sex
IF APCLSEX'="B"
IF APCLSEX'=AUPNSEX
QUIT
+5 ;
+6 ; Quit if communities are selected and the patient's community is blank
+7 ; or the patient's community is not one of the ones selected
+8 ;
+9 SET APCLCMTY=$$COMMRES^AUPNPAT(DFN,"E")
IF "-1"[APCLCMTY
SET APCLCMTY=$PIECE($GET(^AUPNPAT(DFN,11)),U,18)
+10 IF $DATA(APCLCOMM)
IF APCLCMTY=""
QUIT
IF '$DATA(APCLCOMM(APCLCMTY))
QUIT
+11 ; the ~ puts it last in the sort
IF APCLCMTY=""
SET APCLCMTY="~UNKNOWN"
+12 ; Quit if no birth date
+13 IF AUPNDOB=""
QUIT
+14 SET APCLAGE=(AUPNDAYS\365.25)
+15 ; returns classifications/beneficiary in format F
SET APCLCLAS=$$BEN^AUPNPAT(DFN,"C")
+16 IF APCLCLAS=""
QUIT
+17 IF APCLIBEN=1
IF APCLCLAS'="01"
QUIT
+18 ;recalculate age based on date of weight
SET X1=DT
SET X2=AUPNDOB
DO ^%DTC
SET APCLAGE=(X\365.25)
+19 IF $DATA(APCLAGER)
IF APCLAGE<$PIECE(APCLAGER,"-")
QUIT
IF APCLAGE>$PIECE(APCLAGER,"-",2)
QUIT
+20 ;
+21 ; APCLOCTL - Blood pressure out of control flag
+22 ;
+23 SET (APCLOCTL,APCLTSBP,APCLTDBP,APCLBPC)=0
+24 SET APCLDT=APCLED-1
FOR
SET APCLDT=$ORDER(^AUPNVMSR("AA",DFN,APCLBTYP,APCLDT))
IF 'APCLDT
QUIT
IF APCLDT>APCLSD
QUIT
Begin DoDot:1
+25 SET APCLMIEN=0
FOR
SET APCLMIEN=$ORDER(^AUPNVMSR("AA",DFN,APCLBTYP,APCLDT,APCLMIEN))
IF 'APCLMIEN
QUIT
IF $DATA(^AUPNVMSR(APCLMIEN))
Begin DoDot:2
+26 ;entered in error
IF $PIECE($GET(^AUPNVMSR(APCLMIEN,2)),U,1)
QUIT
+27 SET APCLVSIT=$PIECE(^AUPNVMSR(APCLMIEN,0),U,3)
SET APCLCLIN=$PIECE(^AUPNVSIT(APCLVSIT,0),U,8)
+28 IF $DATA(APCLCLNT)
IF APCLCLIN=""
QUIT
IF '$DATA(APCLCLNT(APCLCLIN))
QUIT
+29 SET APCLVCLN=APCLCLIN
SET APCLBPC=APCLBPC+1
SET APCLSBP=$PIECE(^AUPNVMSR(APCLMIEN,0),U,4)
SET APCLDBP=$PIECE(APCLSBP,"/",2)
SET APCLSBP=+APCLSBP
SET APCLTSBP=APCLTSBP+APCLSBP
SET APCLTDBP=APCLTDBP+APCLDBP
End DoDot:2
End DoDot:1
+30 ;
+31 ; If blood pressure count (APCLPBC) > 0 then the patient meets the selection criteria
+32 ; APCLPTOT - Total patients that were checked
+33 ; APCLTPOC - Total patients with BP out of control
+34 ; APCLTOCTL blood pressure out of control flag
+35 ; = 1 or 11 Systolic out of control (#10>0)
+36 ; = 10 or 11 Diastolic out of control (> 1)
+37 IF APCLBPC
Begin DoDot:1
+38 SET APCLOCTL=0
SET APCLMSBP=APCLTSBP\APCLBPC
+39 IF APCLMSBP>139
SET APCLOCTL=1
+40 IF APCLRTYP="S"
SET APCLBPTY=1
SET APCLSORT=APCLCMTY
SET APCLTBP=APCLTSBP
DO COUNT1
SET APCLSORT=0
DO COUNT1
+41 SET APCLMDBP=APCLTDBP\APCLBPC
IF APCLMDBP>89
SET APCLOCTL=APCLOCTL+10
+42 IF APCLOCTL
IF APCLRTYP="C"
SET ^DIBT(APCLSTMP,1,DFN)=""
QUIT
+43 IF APCLRTYP="S"
SET APCLBPTY=2
SET APCLSORT=APCLCMTY
SET APCLTBP=APCLTDBP
DO COUNT1
SET APCLSORT=0
DO COUNT1
End DoDot:1
+44 IF APCLRTYP="C"
QUIT
+45 Begin DoDot:1
+46 ;If the report type is Detail save patient data and B/P readings only,
+47 ; otherwise collect summary statistics data
+48 ;
+49 IF APCLRTYP="D"
IF APCLOCTL
DO SET
QUIT
+50 ; do count for community
SET APCLSORT=APCLCMTY
DO COUNT
+51 ; do count for total
SET APCLSORT=0
DO COUNT
End DoDot:1
+52 QUIT
+53 ;
+54 ; APCLSORT - is the community name, it's set to zero when summing stats
+55 ; for the grand total
+56 ;
+57 ; stored at the APCLSORT level:
+58 ;Piece
+59 ; 1 APCLCPT - Patient count
+60 ; 2 APCLCBC - count of blood pressures taken
+61 ; APCLTYP = 1 used to store systolic values
+62 ; = 2 used to store diastolic values
+63 ; Pieces stored at this level pertaining to the specific type
+64 ; 1 Sum total of values of blood pressure readings
+65 ; 2 total out of countrol patients
+66 ; 3 total out of control counts of B/P
+67 ; 4 Sum total of values of blood pressures readings for
+68 ; out of control blood pressures
+69 ;
+70 ; Used for setting data for the statistical summary report
COUNT ;
+1 SET APCLPTOT=APCLPTOT+1
+2 SET APCLX=$GET(^XTMP("APCLBP",APCLJOB,APCLBTH,"STATS",APCLSORT))
+3 SET APCLCPT=$PIECE(APCLX,U)+1
SET APCLTOPT=$PIECE(APCLX,U,2)+(APCLOCTL>0)
SET APCLCBC=$PIECE(APCLX,U,3)+APCLBPC
+4 SET ^XTMP("APCLBP",APCLJOB,APCLBTH,"STATS",APCLSORT)=APCLCPT_U_APCLTOPT_U_APCLCBC
+5 QUIT
+6 ;
COUNT1 ;
+1 SET APCLX=$GET(^XTMP("APCLBP",APCLJOB,APCLBTH,"STATS",APCLSORT,APCLBPTY))
+2 SET APCLCTB=$PIECE(APCLX,U,1)+APCLTBP
SET APCLTOP=$PIECE(APCLX,U,2)
SET APCLTOBC=$PIECE(APCLX,U,3)
SET APCLTOBP=$PIECE(APCLX,U,4)
+3 IF APCLOCTL
IF $SELECT(APCLBPTY=1:APCLOCTL#10,1:APCLOCTL>1)
SET APCLTOP=APCLTOP+1
SET APCLTOBC=APCLTOBC+APCLBPC
SET APCLTOBP=APCLTOBP+APCLTBP
+4 SET ^XTMP("APCLBP",APCLJOB,APCLBTH,"STATS",APCLSORT,APCLBPTY)=APCLCTB_U_APCLTOP_U_APCLTOBC_U_APCLTOBP
+5 QUIT
+6 ;
+7 ; Collects data for the detail report
SET ;
+1 SET APCLPTOT=APCLPTOT+1
+2 SET APCLNAME=$PIECE(^DPT(DFN,0),U)
+3 SET APCLHRN=$SELECT($DATA(^AUPNPAT(DFN,41,DUZ(2),0)):$PIECE(^(0),U,2),1:"NONE")
+4 ; If sort is neither Patient or Age then the report type must be
+5 ; Summary, not Detail, therefore community will be used for the sort
+6 SET APCLSRT=$SELECT(APCLSORT="P":APCLNAME,APCLSORT="A":APCLAGE,1:APCLCMTY)
+7 IF APCLVCLN'=""
SET APCLVCLN=$PIECE(^DIC(40.7,APCLVCLN,0),U,1)
+8 SET ^XTMP("APCLBP",APCLJOB,APCLBTH,"PATS",APCLSRT,DFN)=APCLNAME_U_APCLHRN_U_APCLAGE_U_AUPNSEX_U_APCLCMTY_U_APCLVCLN_U_APCLBPC_U_$JUSTIFY(APCLMSBP,3)_"/"_APCLMDBP
+9 QUIT
+10 ;
KILL ;
+1 KILL APCLAGE,APCLBPC,APCLBPTY,APCLBTYP,APCLCBC,APCLCLAS,APCLCMTY,APCLCPT,APCLCTB,APCLDT,APCLGRAN,APCLHRN,APCLMBP,APCLMDBP,APCLMIEN,APCLMSBP,APCLNAME,APCLOCTL,APCLSORT,APCLSRT,APCLTBP
+2 KILL APCLTDBP,APCLTOBC,APCLTOBP,APCLTOP,APCLTOPT,APCLTPOC,APCLTSBP,APCLVCLN,APCLX,DFN,X1,X2,Y
+3 DO KILL^AUPNPAT
+4 QUIT
