BCHRP2P.m

BCHRP2P ; IHS/CMI/LAB - print all visit report ; 

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

 ;IHS/CMI/LAB - tmp to xtmp

START ;

 D NOW^%DTC S Y=X D DD^%DT S BCHDT=Y

 S Y=BCHBD D DD^%DT S BCHBDD=Y S Y=BCHED D DD^%DT S BCHEDD=Y

 S (BCHATOT,BCHFTOT,BCHPTOT,BCHPG)=0

 D @("HEAD"_(2-($E(IOST,1,2)="C-")))

 K BCHQUIT

PROG ;

 S BCHPROG="" F  S BCHPROG=$O(^XTMP("BCHRP2",BCHJOB,BCHBTH,"RECORDS",BCHPROG)) Q:BCHPROG=""!($D(BCHQUIT))  D

 .S (BCHATOT("R"),BCHATOT("AT"),BCHATOT("P"))=0

 .I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)

 .W !,"PROGRAM:  ",BCHPROG

 .D LOC

 .Q:$D(BCHQUIT)

 .I $Y>(IOSL-5) D HEAD Q:$D(BCHQUIT)

 .W !?50,"=======",?60,"=======",!

 .;W "PROGRAM TOTAL:",?50,$J(BCHATOT("R"),7),?60,$J(BCHATOT("AT"),7),!

 .W "PROGRAM TOTAL:",?50,$J(BCHATOT("R"),7),?60,$J((BCHATOT("AT")/60),7,1),!

DONE ;

 D DONE^BCHUTIL1

 K ^XTMP("BCHRP2",BCHJOB,BCHBTH),BCHJOB,BCHBTH

 Q

LOC ;

 S BCHLOC="" F  S BCHLOC=$O(^XTMP("BCHRP2",BCHJOB,BCHBTH,"RECORDS",BCHPROG,BCHLOC)) Q:BCHLOC=""!($D(BCHQUIT))  D

 .S (BCHLTOT("R"),BCHLTOT("AT"),BCHLTOT("P"))=0

 .I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)

 .W !?10,"ACTIVITY LOCATION:  ",BCHLOC

 .D PROV

 .Q:$D(BCHQUIT)

 .I $Y>(IOSL-5) D HEAD Q:$D(BCHQUIT)

 .W !?50,"=======",?60,"=======",!

 .W ?10,"ACTIVITY LOCATION TOTAL:",?50,$J(BCHLTOT("R"),7),?60,$J((BCHLTOT("AT")/60),7,1),!

 Q

PROV ;

 S BCHPROV="" F  S BCHPROV=$O(^XTMP("BCHRP2",BCHJOB,BCHBTH,"RECORDS",BCHPROG,BCHLOC,BCHPROV)) Q:BCHPROV=""!($D(BCHQUIT))  D

 .S (BCHPTOT("R"),BCHPTOT("AT"),BCHPTOT("P"))=0

 .I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)

 .W !?15,"PROVIDER:  ",BCHPROV

 .D ACT

 .Q:$D(BCHQUIT)

 .I $Y>(IOSL-5) D HEAD Q:$D(BCHQUIT)

 .W !?50,"=======",?60,"=======",!

 .W ?15,"PROVIDER TOTAL:",?50,$J(BCHPTOT("R"),7),?60,$J((BCHPTOT("AT")/60),7,1),!

 Q

ACT ;

 S BCHACT="" F  S BCHACT=$O(^XTMP("BCHRP2",BCHJOB,BCHBTH,"RECORDS",BCHPROG,BCHLOC,BCHPROV,BCHACT)) Q:BCHACT=""!($D(BCHQUIT))  D

 .I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)

 .S BCHREC=$P(^XTMP("BCHRP2",BCHJOB,BCHBT,"RECORDS",BCHPROG,BCHLOC,BCHPROV,BCHACT),U),BCHAT=$P(^(BCHACT),U,2),BCHPAT=$P(^(BCHACT),U,3)

 .W !?20,$E(BCHACT,1,29),?50,$J(BCHREC,7),?60,$J((BCHAT/60),7,1)

 .S BCHATOT("R")=BCHATOT("R")+BCHREC,BCHLTOT("R")=BCHLTOT("R")+BCHREC,BCHPTOT("R")=BCHPTOT("R")+BCHREC

 .S BCHATOT("AT")=BCHATOT("AT")+BCHAT,BCHLTOT("AT")=BCHLTOT("AT")+BCHAT,BCHPTOT("AT")=BCHPTOT("AT")+BCHAT

 .S BCHATOT("P")=BCHATOT("P")+BCHPAT,BCHLTOT("P")=BCHLTOT("P")+BCHPAT,BCHPTOT("P")=BCHPTOT("P")+BCHPAT

 Q

HEAD ;I 'BCHPG G HEAD1

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BCHQUIT="" Q

HEAD1 ; if terminal

 W:$D(IOF) @IOF

HEAD2 ; if printer

 S BCHPG=BCHPG+1

 W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 W !?28,"CHR/PCC ACTIVITY REPORT"

 W !,$P(^VA(200,DUZ,0),U,2),?58,BCHDT,?72,"Page ",BCHPG,!

 W $$CTR^BCHRLU($$LOC^BCHRLU),!

 S BCHPROGN=$S(BCHPRG:$P(^BCHTPROG(BCHPRG,0),U)_" ("_$P(^(0),U,5)_")",1:"ALL"),X=$L(BCHPROGN)+10

 W ?((80-X)/2),"PROGRAM:  ",BCHPROGN,!

 S X=$L("PATIENTS:  "_BCHREGN)

 W ?((80-X)/2),"PATIENTS:  ",BCHREGN

 W !?17,"REPORT DATES:  ",BCHBDD,"  TO  ",BCHEDD,!

 W !?45,"# Activities",?60,"ACT TIME (hrs)"

 W !,$TR($J(" ",80)," ","-")

 Q

BCHRP2P   ; IHS/CMI/LAB - print all visit report ; 

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

 +2       ;IHS/CMI/LAB - tmp to xtmp

START     ;

 +1        DO NOW^%DTC

           SET Y=X

           DO DD^%DT

           SET BCHDT=Y

 +2        SET Y=BCHBD

           DO DD^%DT

           SET BCHBDD=Y

           SET Y=BCHED

           DO DD^%DT

           SET BCHEDD=Y

 +3        SET (BCHATOT,BCHFTOT,BCHPTOT,BCHPG)=0

 +4        DO @("HEAD"_(2-($EXTRACT(IOST,1,2)="C-")))

 +5        KILL BCHQUIT

PROG      ;

 +1        SET BCHPROG=""

           FOR 

               SET BCHPROG=$ORDER(^XTMP("BCHRP2",BCHJOB,BCHBTH,"RECORDS",BCHPROG))

               IF BCHPROG=""!($DATA(BCHQUIT))

                   QUIT 

               Begin DoDot:1

 +2                SET (BCHATOT("R"),BCHATOT("AT"),BCHATOT("P"))=0

 +3                IF $Y>(IOSL-4)

                       DO HEAD

                       IF $DATA(BCHQUIT)

                           QUIT 

 +4                WRITE !,"PROGRAM:  ",BCHPROG

 +5                DO LOC

 +6                IF $DATA(BCHQUIT)

                       QUIT 

 +7                IF $Y>(IOSL-5)

                       DO HEAD

                       IF $DATA(BCHQUIT)

                           QUIT 

 +8                WRITE !?50,"=======",?60,"=======",!

 +9       ;W "PROGRAM TOTAL:",?50,$J(BCHATOT("R"),7),?60,$J(BCHATOT("AT"),7),!

 +10               WRITE "PROGRAM TOTAL:",?50,$JUSTIFY(BCHATOT("R"),7),?60,$JUSTIFY((BCHATOT("AT")/60),7,1),!

               End DoDot:1

DONE      ;

 +1        DO DONE^BCHUTIL1

 +2        KILL ^XTMP("BCHRP2",BCHJOB,BCHBTH),BCHJOB,BCHBTH

 +3        QUIT 

LOC       ;

 +1        SET BCHLOC=""

           FOR 

               SET BCHLOC=$ORDER(^XTMP("BCHRP2",BCHJOB,BCHBTH,"RECORDS",BCHPROG,BCHLOC))

               IF BCHLOC=""!($DATA(BCHQUIT))

                   QUIT 

               Begin DoDot:1

 +2                SET (BCHLTOT("R"),BCHLTOT("AT"),BCHLTOT("P"))=0

 +3                IF $Y>(IOSL-4)

                       DO HEAD

                       IF $DATA(BCHQUIT)

                           QUIT 

 +4                WRITE !?10,"ACTIVITY LOCATION:  ",BCHLOC

 +5                DO PROV

 +6                IF $DATA(BCHQUIT)

                       QUIT 

 +7                IF $Y>(IOSL-5)

                       DO HEAD

                       IF $DATA(BCHQUIT)

                           QUIT 

 +8                WRITE !?50,"=======",?60,"=======",!

 +9                WRITE ?10,"ACTIVITY LOCATION TOTAL:",?50,$JUSTIFY(BCHLTOT("R"),7),?60,$JUSTIFY((BCHLTOT("AT")/60),7,1),!

               End DoDot:1

 +10       QUIT 

PROV      ;

 +1        SET BCHPROV=""

           FOR 

               SET BCHPROV=$ORDER(^XTMP("BCHRP2",BCHJOB,BCHBTH,"RECORDS",BCHPROG,BCHLOC,BCHPROV))

               IF BCHPROV=""!($DATA(BCHQUIT))

                   QUIT 

               Begin DoDot:1

 +2                SET (BCHPTOT("R"),BCHPTOT("AT"),BCHPTOT("P"))=0

 +3                IF $Y>(IOSL-4)

                       DO HEAD

                       IF $DATA(BCHQUIT)

                           QUIT 

 +4                WRITE !?15,"PROVIDER:  ",BCHPROV

 +5                DO ACT

 +6                IF $DATA(BCHQUIT)

                       QUIT 

 +7                IF $Y>(IOSL-5)

                       DO HEAD

                       IF $DATA(BCHQUIT)

                           QUIT 

 +8                WRITE !?50,"=======",?60,"=======",!

 +9                WRITE ?15,"PROVIDER TOTAL:",?50,$JUSTIFY(BCHPTOT("R"),7),?60,$JUSTIFY((BCHPTOT("AT")/60),7,1),!

               End DoDot:1

 +10       QUIT 

ACT       ;

 +1        SET BCHACT=""

           FOR 

               SET BCHACT=$ORDER(^XTMP("BCHRP2",BCHJOB,BCHBTH,"RECORDS",BCHPROG,BCHLOC,BCHPROV,BCHACT))

               IF BCHACT=""!($DATA(BCHQUIT))

                   QUIT 

               Begin DoDot:1

 +2                IF $Y>(IOSL-4)

                       DO HEAD

                       IF $DATA(BCHQUIT)

                           QUIT 

 +3                SET BCHREC=$PIECE(^XTMP("BCHRP2",BCHJOB,BCHBT,"RECORDS",BCHPROG,BCHLOC,BCHPROV,BCHACT),U)

                   SET BCHAT=$PIECE(^(BCHACT),U,2)

                   SET BCHPAT=$PIECE(^(BCHACT),U,3)

 +4                WRITE !?20,$EXTRACT(BCHACT,1,29),?50,$JUSTIFY(BCHREC,7),?60,$JUSTIFY((BCHAT/60),7,1)

 +5                SET BCHATOT("R")=BCHATOT("R")+BCHREC

                   SET BCHLTOT("R")=BCHLTOT("R")+BCHREC

                   SET BCHPTOT("R")=BCHPTOT("R")+BCHREC

 +6                SET BCHATOT("AT")=BCHATOT("AT")+BCHAT

                   SET BCHLTOT("AT")=BCHLTOT("AT")+BCHAT

                   SET BCHPTOT("AT")=BCHPTOT("AT")+BCHAT

 +7                SET BCHATOT("P")=BCHATOT("P")+BCHPAT

                   SET BCHLTOT("P")=BCHLTOT("P")+BCHPAT

                   SET BCHPTOT("P")=BCHPTOT("P")+BCHPAT

               End DoDot:1

 +8        QUIT 

HEAD      ;I 'BCHPG G HEAD1

 +1        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   WRITE !

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF Y=0!(Y="^")!($DATA(DTOUT))

                       SET BCHQUIT=""

                       QUIT 

HEAD1     ; if terminal

 +1        IF $DATA(IOF)

               WRITE @IOF

HEAD2     ; if printer

 +1        SET BCHPG=BCHPG+1

 +2        WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 +3        WRITE !?28,"CHR/PCC ACTIVITY REPORT"

 +4        WRITE !,$PIECE(^VA(200,DUZ,0),U,2),?58,BCHDT,?72,"Page ",BCHPG,!

 +5        WRITE $$CTR^BCHRLU($$LOC^BCHRLU),!

 +6        SET BCHPROGN=$SELECT(BCHPRG:$PIECE(^BCHTPROG(BCHPRG,0),U)_" ("_$PIECE(^(0),U,5)_")",1:"ALL")

           SET X=$LENGTH(BCHPROGN)+10

 +7        WRITE ?((80-X)/2),"PROGRAM:  ",BCHPROGN,!

 +8        SET X=$LENGTH("PATIENTS:  "_BCHREGN)

 +9        WRITE ?((80-X)/2),"PATIENTS:  ",BCHREGN

 +10       WRITE !?17,"REPORT DATES:  ",BCHBDD,"  TO  ",BCHEDD,!

 +11       WRITE !?45,"# Activities",?60,"ACT TIME (hrs)"

 +12       WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")

 +13       QUIT