BCHRPT.m

BCHRPT ; IHS/CMI/LAB - APC visit counts by selected vars ; 

 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 ;

START ; 

 D HOME^%ZIS

 K BCHQUIT

 I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! Q

 I $D(BCHRPTC) D

 .S BCHRPTI=$P(^BCHRCNT(BCHRPTC,0),U,2),BCHRPTPA=$P(^(0),U,3),BCHRPTP=$P(^(0),U,4),BCHRPTST=$P(^BCHRCNT(BCHRPTC,0),U,7) S:BCHRPTST]"" BCHRPTST=$TR(BCHRPTST,"~","^")

 .S BCHRPRCR=$P(^BCHRCNT(BCHRPTC,0),U,5) S:BCHRPRCR]"" BCHRPRCR=$TR(BCHRPRCR,"~","^")

 I BCHRPTI]"" S BCHRPTI=$TR(BCHRPTI,"~","^") D @(BCHRPTI) ;inform user what report will do

 G:$D(BCHQUIT) XIT

 S BCHTCW=0,BCHPCNT=0

 S BCHPTVS="V",BCHXREF=$S(BCHPTVS="V":"C",1:"PO")

GETDATES ;

BD ;get beginning date

 W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter BEGINNING Date of Service for Report" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G XIT

 S BCHBD=Y

ED ;get ending date

 W ! S DIR(0)="D^"_BCHBD_":DT:EP",DIR("A")="Enter ENDING Date of Service for Report" S Y=BCHBD D DD^%DT S DIR("B")=Y,Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G BD

 S BCHED=Y

 S X1=BCHBD,X2=-1 D C^%DTC S BCHSD=X S Y=BCHBD D DD^%DT S BCHBDD=Y S Y=BCHED D DD^%DT S BCHEDD=Y

 D ADD ;add report to temporary fileman report file

 I $D(BCHQUIT) W !!,"Unable to create report temporary file entry!!," G XIT

 ;

 D SHOW

SCREEN ;

 D SMENU^BCHRPT0

 S DIR(0)="LO^1:"_BCHHIGH,DIR("A")="Select records based on which of the above" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" D SHOW G PRINT

 I $D(DIRUT) D DEL G START

 ;process all items in Y

 D SELECT^BCHRPT1

 D SHOW

 W !! S DIR(0)="Y",DIR("A")="     Would you like to select additional RECORD criteria",DIR("B")="NO" D ^DIR S:$D(DUOUT) DIRUT=1 K DIR

 G:$D(DIRUT) START

 I Y=0 K ^BCHTRPT(BCHRPT,12) G PRINT

 G SCREEN

 ;

PRINT ;print portion of report

 I $G(BCHRPTP)]"" S BCHRPTPA=$TR(BCHRPTPA,"~","^"),BCHRPTP=$TR(BCHRPTP,"~","^") D:$G(BCHRPTPA)]"" @(BCHRPTPA) G:$D(BCHQUIT) START G SORT

 D PMENU^BCHRPT0

 S DIR(0)="LO^1:"_BCHHIGH,DIR("A")="Select print item(s)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" G SORT

 I $D(DIRUT) D DEL G START

 W !!?15,"Total Report width (including column margins - 2 spaces):  ",BCHTCW

 D PSELECT^BCHRPT1

 D SHOWP

 W !! S DIR(0)="Y",DIR("A")="      Would you like to select additional PRINT items",DIR("B")="NO" D ^DIR K DIR

 S:$D(DUOUT) DIRUT=1

 G:$D(DIRUT) START

 I Y=0 G SORT

 G PRINT

SORT ;

 I '$D(^BCHTRPT(BCHRPT,12)),'$D(BCHRPTP) W !!,"NO PRINT FIELDS SELECTED!!",$C(7),$C(7) D DEL G START

 I '$P(^BCHRCNT(BCHRPTC,0),U,8) G ZIS

 S BCHSORT=""

 D SHOWR

 D RMENU^BCHRPT0

 W ! S DIR(0)="NO^1:"_BCHHIGH_":0",DIR("A")="Sort records by which of the above" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" W !!,"No sort criteria selected ... will sort by record date." S BCHSORT=19,BCHSORV="Date of Service" H 3 G ZIS

 I $D(DIRUT) D DEL G START

 S BCHSORT=BCHSEL(+Y),BCHSORV=$P(^BCHSORT(BCHSORT,0),U)

PAGE ;

 K BCHSPAG

 S DIR(0)="Y",DIR("A")="Do you want a separate page for each "_BCHSORV,DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G SORT

 S BCHSPAG=Y

ZIS ;call to XBDBQUE

REG ;

 S BCHREG="",BCHREGN=""

 S DIR(0)="S^R:Registered Patients;N:Non-Registered Patients;B:Both Registered and Non-Registered Patients",DIR("A")="Include which Patients",DIR("B")="B" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) Q

 S BCHREG=Y,BCHREGN=Y(0)

 D KILLVARS

 S XBRP=BCHRPTP,XBRC=$S($G(BCHRPRCR)]"":BCHRPRCR,1:"^BCHRPT4"),XBRX="XIT^BCHRPT",XBNS="BCH"

 D ^XBDBQUE

 D XIT

 Q

SHOW ;

 W:$D(IOF) @IOF

 I $D(BCHDONE) S BCHLHDR="REPORT SUMMARY" W ?((80-$L(BCHLHDR))/2),BCHLHDR,!

 W !?6,"Record selection criteria:"

 W !,"Date of Service range:  ",BCHBDD," to ",BCHEDD,"."

 Q:'$D(^BCHTRPT(BCHRPT,11))

 S BCHI=0 F  S BCHI=$O(^BCHTRPT(BCHRPT,11,BCHI)) Q:BCHI'=+BCHI  D

 .I $Y>(IOSL-5) D PAUSE^BCHRPTU W @IOF

 .W !?12,$P(^BCHSORT(BCHI,0),U),":  "

 .K BCHQ S Y=0,C=0 F  S Y=$O(^BCHTRPT(BCHRPT,11,BCHI,11,"B",Y)) S C=C+1 W:C'=1&(Y'="") " ; " Q:Y=""!($D(BCHQ))  S X=Y X:$D(^BCHSORT(BCHI,2)) ^(2) D

 ..W X

 .K BCHQ

 K C

 Q

SHOWP ;

 I '$D(BCHDONE) W:$D(IOF) @IOF

 W !!?6,"PRINT Field(s) Selected:"

 ;Q:'$D(^BCHTRPT(BCHRPT,12))

 S (BCHI,BCHTCW)=0 F  S BCHI=$O(^BCHTRPT(BCHRPT,12,BCHI)) Q:BCHI'=+BCHI  S BCHCRIT=$P(^BCHTRPT(BCHRPT,12,BCHI,0),U) D

 .W !?12,$P(^BCHSORT(BCHCRIT,0),U)," - column width ",$P(^BCHTRPT(BCHRPT,12,BCHI,0),U,2) S BCHTCW=BCHTCW+$P(^(0),U,2)+2

 .I $Y>(IOSL-5) D PAUSE^BCHRPTU W:$D(IOF) @IOF

 W !!?12,"Total Report width (including column margins - 2 spaces):   ",BCHTCW

 Q

SHOWR ;

 I '$D(BCHDONE) W:$D(IOF) @IOF

 W !!?6,"Record SORTING Criteria"

 Q:'$G(BCHTRPT)

 W !!?12,"Records will be sorted by:  ",$P(^BCHSORT(BCHTRPT,0),U),!

 Q

DEL ;EP - delete entry in temp file

 I $G(BCHRPT) S DIK="^BCHTRPT(",DA=BCHRPT D ^DIK K DIK,DA,DIC

 Q

KILLVARS ;

 K BCHDISP,BCHSEL

 Q

XIT ;

 D KILL^BCHRPTX

 Q

ADD ;EP

 S %H=$H D YX^%DTC S X=$P(^VA(200,DUZ,0),U)_"-"_Y,DIC(0)="L",DIC="^BCHTRPT(",DLAYGO=90002.42,DIADD=1 D ^DIC K DIC,DA,DR,DIADD,DLAYGO I Y=-1 W !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!" S BCHQUIT=1 Q

 S BCHRPT=+Y

 K DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM

 ;DELETE ALL 11 MULTIPLE HERE

 K ^BCHTRPT(BCHRPT,11)

 Q

BCHRPT    ; IHS/CMI/LAB - APC visit counts by selected vars ; 

 +1       ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 +2       ;

START     ; 

 +1        DO HOME^%ZIS

 +2        KILL BCHQUIT

 +3        IF '$GET(DUZ(2))

               WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!!

               QUIT 

 +4        IF $DATA(BCHRPTC)

               Begin DoDot:1

 +5                SET BCHRPTI=$PIECE(^BCHRCNT(BCHRPTC,0),U,2)

                   SET BCHRPTPA=$PIECE(^(0),U,3)

                   SET BCHRPTP=$PIECE(^(0),U,4)

                   SET BCHRPTST=$PIECE(^BCHRCNT(BCHRPTC,0),U,7)

                   IF BCHRPTST]""

                       SET BCHRPTST=$TRANSLATE(BCHRPTST,"~","^")

 +6                SET BCHRPRCR=$PIECE(^BCHRCNT(BCHRPTC,0),U,5)

                   IF BCHRPRCR]""

                       SET BCHRPRCR=$TRANSLATE(BCHRPRCR,"~","^")

               End DoDot:1

 +7       ;inform user what report will do

           IF BCHRPTI]""

               SET BCHRPTI=$TRANSLATE(BCHRPTI,"~","^")

               DO @(BCHRPTI)

 +8        IF $DATA(BCHQUIT)

               GOTO XIT

 +9        SET BCHTCW=0

           SET BCHPCNT=0

 +10       SET BCHPTVS="V"

           SET BCHXREF=$SELECT(BCHPTVS="V":"C",1:"PO")

GETDATES  ;

BD        ;get beginning date

 +1        WRITE !

           SET DIR(0)="D^:DT:EP"

           SET DIR("A")="Enter BEGINNING Date of Service for Report"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO XIT

 +3        SET BCHBD=Y

ED        ;get ending date

 +1        WRITE !

           SET DIR(0)="D^"_BCHBD_":DT:EP"

           SET DIR("A")="Enter ENDING Date of Service for Report"

           SET Y=BCHBD

           DO DD^%DT

           SET DIR("B")=Y

           SET Y=""

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO BD

 +3        SET BCHED=Y

 +4        SET X1=BCHBD

           SET X2=-1

           DO C^%DTC

           SET BCHSD=X

           SET Y=BCHBD

           DO DD^%DT

           SET BCHBDD=Y

           SET Y=BCHED

           DO DD^%DT

           SET BCHEDD=Y

 +5       ;add report to temporary fileman report file

           DO ADD

 +6        IF $DATA(BCHQUIT)

               WRITE !!,"Unable to create report temporary file entry!!,"

               GOTO XIT

 +7       ;

 +8        DO SHOW

SCREEN    ;

 +1        DO SMENU^BCHRPT0

 +2        SET DIR(0)="LO^1:"_BCHHIGH

           SET DIR("A")="Select records based on which of the above"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF Y=""

               DO SHOW

               GOTO PRINT

 +4        IF $DATA(DIRUT)

               DO DEL

               GOTO START

 +5       ;process all items in Y

 +6        DO SELECT^BCHRPT1

 +7        DO SHOW

 +8        WRITE !!

           SET DIR(0)="Y"

           SET DIR("A")="     Would you like to select additional RECORD criteria"

           SET DIR("B")="NO"

           DO ^DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

           KILL DIR

 +9        IF $DATA(DIRUT)

               GOTO START

 +10       IF Y=0

               KILL ^BCHTRPT(BCHRPT,12)

               GOTO PRINT

 +11       GOTO SCREEN

 +12      ;

PRINT     ;print portion of report

 +1        IF $GET(BCHRPTP)]""

               SET BCHRPTPA=$TRANSLATE(BCHRPTPA,"~","^")

               SET BCHRPTP=$TRANSLATE(BCHRPTP,"~","^")

               IF $GET(BCHRPTPA)]""

                   DO @(BCHRPTPA)

               IF $DATA(BCHQUIT)

                   GOTO START

               GOTO SORT

 +2        DO PMENU^BCHRPT0

 +3        SET DIR(0)="LO^1:"_BCHHIGH

           SET DIR("A")="Select print item(s)"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF Y=""

               GOTO SORT

 +5        IF $DATA(DIRUT)

               DO DEL

               GOTO START

 +6        WRITE !!?15,"Total Report width (including column margins - 2 spaces):  ",BCHTCW

 +7        DO PSELECT^BCHRPT1

 +8        DO SHOWP

 +9        WRITE !!

           SET DIR(0)="Y"

           SET DIR("A")="      Would you like to select additional PRINT items"

           SET DIR("B")="NO"

           DO ^DIR

           KILL DIR

 +10       IF $DATA(DUOUT)

               SET DIRUT=1

 +11       IF $DATA(DIRUT)

               GOTO START

 +12       IF Y=0

               GOTO SORT

 +13       GOTO PRINT

SORT      ;

 +1        IF '$DATA(^BCHTRPT(BCHRPT,12))

               IF '$DATA(BCHRPTP)

                   WRITE !!,"NO PRINT FIELDS SELECTED!!",$CHAR(7),$CHAR(7)

                   DO DEL

                   GOTO START

 +2        IF '$PIECE(^BCHRCNT(BCHRPTC,0),U,8)

               GOTO ZIS

 +3        SET BCHSORT=""

 +4        DO SHOWR

 +5        DO RMENU^BCHRPT0

 +6        WRITE !

           SET DIR(0)="NO^1:"_BCHHIGH_":0"

           SET DIR("A")="Sort records by which of the above"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +7        IF Y=""

               WRITE !!,"No sort criteria selected ... will sort by record date."

               SET BCHSORT=19

               SET BCHSORV="Date of Service"

               HANG 3

               GOTO ZIS

 +8        IF $DATA(DIRUT)

               DO DEL

               GOTO START

 +9        SET BCHSORT=BCHSEL(+Y)

           SET BCHSORV=$PIECE(^BCHSORT(BCHSORT,0),U)

PAGE      ;

 +1        KILL BCHSPAG

 +2        SET DIR(0)="Y"

           SET DIR("A")="Do you want a separate page for each "_BCHSORV

           SET DIR("B")="N"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               GOTO SORT

 +4        SET BCHSPAG=Y

ZIS       ;call to XBDBQUE

REG       ;

 +1        SET BCHREG=""

           SET BCHREGN=""

 +2        SET DIR(0)="S^R:Registered Patients;N:Non-Registered Patients;B:Both Registered and Non-Registered Patients"

           SET DIR("A")="Include which Patients"

           SET DIR("B")="B"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               QUIT 

 +4        SET BCHREG=Y

           SET BCHREGN=Y(0)

 +5        DO KILLVARS

 +6        SET XBRP=BCHRPTP

           SET XBRC=$SELECT($GET(BCHRPRCR)]"":BCHRPRCR,1:"^BCHRPT4")

           SET XBRX="XIT^BCHRPT"

           SET XBNS="BCH"

 +7        DO ^XBDBQUE

 +8        DO XIT

 +9        QUIT 

SHOW      ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        IF $DATA(BCHDONE)

               SET BCHLHDR="REPORT SUMMARY"

               WRITE ?((80-$LENGTH(BCHLHDR))/2),BCHLHDR,!

 +3        WRITE !?6,"Record selection criteria:"

 +4        WRITE !,"Date of Service range:  ",BCHBDD," to ",BCHEDD,"."

 +5        IF '$DATA(^BCHTRPT(BCHRPT,11))

               QUIT 

 +6        SET BCHI=0

           FOR 

               SET BCHI=$ORDER(^BCHTRPT(BCHRPT,11,BCHI))

               IF BCHI'=+BCHI

                   QUIT 

               Begin DoDot:1

 +7                IF $Y>(IOSL-5)

                       DO PAUSE^BCHRPTU

                       WRITE @IOF

 +8                WRITE !?12,$PIECE(^BCHSORT(BCHI,0),U),":  "

 +9                KILL BCHQ

                   SET Y=0

                   SET C=0

                   FOR 

                       SET Y=$ORDER(^BCHTRPT(BCHRPT,11,BCHI,11,"B",Y))

                       SET C=C+1

                       IF C'=1&(Y'="")

                           WRITE " ; "

                       IF Y=""!($DATA(BCHQ))

                           QUIT 

                       SET X=Y

                       IF $DATA(^BCHSORT(BCHI,2))

                           XECUTE ^(2)

                       Begin DoDot:2

 +10                       WRITE X

                       End DoDot:2

 +11               KILL BCHQ

               End DoDot:1

 +12       KILL C

 +13       QUIT 

SHOWP     ;

 +1        IF '$DATA(BCHDONE)

               IF $DATA(IOF)

                   WRITE @IOF

 +2        WRITE !!?6,"PRINT Field(s) Selected:"

 +3       ;Q:'$D(^BCHTRPT(BCHRPT,12))

 +4        SET (BCHI,BCHTCW)=0

           FOR 

               SET BCHI=$ORDER(^BCHTRPT(BCHRPT,12,BCHI))

               IF BCHI'=+BCHI

                   QUIT 

               SET BCHCRIT=$PIECE(^BCHTRPT(BCHRPT,12,BCHI,0),U)

               Begin DoDot:1

 +5                WRITE !?12,$PIECE(^BCHSORT(BCHCRIT,0),U)," - column width ",$PIECE(^BCHTRPT(BCHRPT,12,BCHI,0),U,2)

                   SET BCHTCW=BCHTCW+$PIECE(^(0),U,2)+2

 +6                IF $Y>(IOSL-5)

                       DO PAUSE^BCHRPTU

                       IF $DATA(IOF)

                           WRITE @IOF

               End DoDot:1

 +7        WRITE !!?12,"Total Report width (including column margins - 2 spaces):   ",BCHTCW

 +8        QUIT 

SHOWR     ;

 +1        IF '$DATA(BCHDONE)

               IF $DATA(IOF)

                   WRITE @IOF

 +2        WRITE !!?6,"Record SORTING Criteria"

 +3        IF '$GET(BCHTRPT)

               QUIT 

 +4        WRITE !!?12,"Records will be sorted by:  ",$PIECE(^BCHSORT(BCHTRPT,0),U),!

 +5        QUIT 

DEL       ;EP - delete entry in temp file

 +1        IF $GET(BCHRPT)

               SET DIK="^BCHTRPT("

               SET DA=BCHRPT

               DO ^DIK

               KILL DIK,DA,DIC

 +2        QUIT 

KILLVARS  ;

 +1        KILL BCHDISP,BCHSEL

 +2        QUIT 

XIT       ;

 +1        DO KILL^BCHRPTX

 +2        QUIT 

ADD       ;EP

 +1        SET %H=$HOROLOG

           DO YX^%DTC

           SET X=$PIECE(^VA(200,DUZ,0),U)_"-"_Y

           SET DIC(0)="L"

           SET DIC="^BCHTRPT("

           SET DLAYGO=90002.42

           SET DIADD=1

           DO ^DIC

           KILL DIC,DA,DR,DIADD,DLAYGO

           IF Y=-1

               WRITE !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!"

               SET BCHQUIT=1

               QUIT 

 +2        SET BCHRPT=+Y

 +3        KILL DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM

 +4       ;DELETE ALL 11 MULTIPLE HERE

 +5        KILL ^BCHTRPT(BCHRPT,11)

 +6        QUIT