APCLBP1.m

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