BDPPHXD ; IHS/CMI/TMJ - LISTING OF RECORDS BY DATE RANGE & CATEGORY ; 05 Jun 2018 11:08 AM
;;2.0;IHS PCC SUITE;**2,21**;MAY 14, 2009;Build 34
;
;
;
D INFORM ;Report Explanation
;
W !
CAT ;
W !
K BDPPROVC
S DIR(0)="SO^O:One Provider Category;A:All Provider Categories",DIR("A")="Do you want to report on ",DIR("B")="O" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D END Q
I Y="A" G ZIS
S DIC="^BDPTCAT(",DIC(0)="AEMQ" D ^DIC K DIC,DA
I Y=-1 G CAT
S BDPPROVC=+Y
ZIS ;
S XBRC="PROC^BDPPHXD",XBRP="PRINT^BDPPHXD",XBNS="BDP",XBRX="END^BDPPHXD"
D ^XBDBQUE
D END
Q
PROC ;
;loop through file and tally by catgegory, skip inactive patients
S BDPJ=$J,BDPH=$H,BDPTCNT=0 K BDPSCNT
K ^XTMP("BDPPHXD",BDPJ,BDPH)
D XTMP^APCLOSUT("BDPPHXD","DESG PROVIDER REPORT")
S BDPX=0 F S BDPX=$O(^BDPRECN("B",BDPX)) Q:BDPX="" D
.I $D(BDPPROVC),BDPPROVC'=BDPX Q
.S BDPIEN=0 F S BDPIEN=$O(^BDPRECN("B",BDPX,BDPIEN)) Q:BDPIEN="" D
..S DFN=$P(^BDPRECN(BDPIEN,0),U,2)
..Q:$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,3) ;inactive patients
..S BDPD=$$VAL^XBDIQ1(90360.1,BDPIEN,.01)
..S ^XTMP("BDPPHXD",BDPJ,BDPH,"HITS",$$VAL^XBDIQ1(90360.1,BDPIEN,.01),$$VAL^XBDIQ1(90360.1,BDPIEN,.02),DFN,BDPIEN)=""
..S BDPTCNT=BDPTCNT+1 S BDPSCNT(BDPD)=$G(BDPSCNT(BDPD))+1
..Q
.Q
Q
PRINT ;PRINT RECORDS BY DATE
S BDPPG=0 K BDPQUIT
D PAGEHEAD
I '$D(^XTMP("BDPPHXD",BDPJ,BDPH,"HITS")) W !,"No data to report." D END Q
S BDPD="" F S BDPD=$O(^XTMP("BDPPHXD",BDPJ,BDPH,"HITS",BDPD)) Q:BDPD=""!($D(BDPQUIT)) D
.I $Y>(IOSL-3) D PAGEHEAD Q:$D(BDPQUIT)
.W !!,"PROVIDER CATEGORY: ",BDPD
.S BDPPN=0 F S BDPPN=$O(^XTMP("BDPPHXD",BDPJ,BDPH,"HITS",BDPD,BDPPN)) Q:BDPPN=""!($D(BDPQUIT)) D
..S DFN=0 F S DFN=$O(^XTMP("BDPPHXD",BDPJ,BDPH,"HITS",BDPD,BDPPN,DFN)) Q:DFN=""!($D(BDPQUIT)) D
...S BDPI=0 F S BDPI=$O(^XTMP("BDPPHXD",BDPJ,BDPH,"HITS",BDPD,BDPPN,DFN,BDPI)) Q:BDPI=""!($D(BDPQUIT)) D
....I $Y>(IOSL-8) D PAGEHEAD Q:$D(BDPQUIT)
....W !!?3,"PATIENT NAME: ",$$VAL^XBDIQ1(90360.1,BDPI,.02),?50,"HEALTH RECORD: ",$$HRN^AUPNPAT(DFN,DUZ(2))
....W !?3,"PROVIDER CATEGORY: ",$$VAL^XBDIQ1(90360.1,BDPI,.01)
....W !?4,"CURRENT PROVIDER: ",$$VAL^XBDIQ1(90360.1,BDPI,.03)
....W !?4,"DATE UPDATED: ",$$VAL^XBDIQ1(90360.1,BDPI,.05)," USER UPDATED: ",$$VAL^XBDIQ1(90360.1,BDPI,.04)
....W !?6,"HISTORY DETAIL:"
....W !?6,"PREVIOUS PROVIDER",?34,"START DATE",?45,"STOP DATE",?57,"UPDATED",?66,"UPDATED BY"
....S BDPX=0 F S BDPX=$O(^BDPRECN(BDPI,1,BDPX)) Q:BDPX'=+BDPX D
.....S BDPN=^BDPRECN(BDPI,1,BDPX,0)
.....;I $P(BDPN,U,1)=$P(^BDPRECN(BDPI,0),U,3),$P(BDPN,U,2)=$P(^BDPRECN(BDPI,0),U,4),$P(BDPN,U,3)=$P(^BDPRECN(BDPI,0),U,5) Q ;already listed last one
.....W !?6,$E($P(^VA(200,$P(BDPN,U,1),0),U,1),1,20),?34,$S($P(BDPN,U,4):$$DATE^BDPLMDSP($P(BDPN,U,4)),1:"Unknown")
.....W ?45,$S($P(BDPN,U,5):$$DATE^BDPLMDSP($P(BDPN,U,5)),1:""),?57,$$DATE^BDPLMDSP($P(BDPN,U,3)),?66,$E($P(^VA(200,$P(BDPN,U,2),0),U),1,12)
.....;W !?8,"OLD PROVIDER: ",$E($P(^VA(200,$P(BDPN,U,1),0),U,1),1,20),?42,$$DATE^BDPLMDSP($P(BDPN,U,3)),?53,"USER: ",$E($P(^VA(200,$P(BDPN,U,2),0),U,1),1,18)
.I $Y>(IOSL-3) D PAGEHEAD Q:$D(BDPQUIT)
.W !,"Subcount: ",BDPSCNT(BDPD),!
I $D(BDPQUIT) G DONE
;I $Y>(IOSL-3) D PAGEHEAD G:$D(BDPQUIT) DONE
;W !!,"Total # of patients: ",BDPTCNT,!
DONE ;
K ^XTMP("BDPPHXD",BDPJ,BDPH)
D END
Q
END ;
D EN^XBVK("BDP")
Q
;
PAGEHEAD ;
HEAD ;EP;HEADER
G:$D(BDPDEM)!($D(BDPDEMM)) HEAD2
I 'BDPPG G HEAD1
HEAD2 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BDPQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF S BDPPG=BDPPG+1
W !,$$FMTE^XLFDT(DT),?70,"Page: ",BDPPG
W !,$$CTR("*****************************************************************",80)
W !,$$CTR("* DESIGNATED PROVIDER PATIENT HISTORY BY CATEGORY *",80)
W !,$$CTR("*****************************************************************",80)
;W !!,"PROVIDER CATEGORY",?22,"PATIENT NAME",?44,"LAST CURRENT PROVIDER",?68,"UPDATE DT"
W !,$$REPEAT^XLFSTR("-",79)
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;
INFORM ;Report Explanation
;
W !?25,"******************************",!
W ?10,"This Report prints a Listing of patients by the provider category."
W !?10,"The report output includes a detailed history of that patient's"
W !?10,"provider history."
W !?25,"*****************************",!
Q
BDPPHXD ; IHS/CMI/TMJ - LISTING OF RECORDS BY DATE RANGE & CATEGORY ; 05 Jun 2018 11:08 AM
+1 ;;2.0;IHS PCC SUITE;**2,21**;MAY 14, 2009;Build 34
+2 ;
+3 ;
+4 ;
+5 ;Report Explanation
DO INFORM
+6 ;
+7 WRITE !
CAT ;
+1 WRITE !
+2 KILL BDPPROVC
+3 SET DIR(0)="SO^O:One Provider Category;A:All Provider Categories"
SET DIR("A")="Do you want to report on "
SET DIR("B")="O"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
DO END
QUIT
+5 IF Y="A"
GOTO ZIS
+6 SET DIC="^BDPTCAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA
+7 IF Y=-1
GOTO CAT
+8 SET BDPPROVC=+Y
ZIS ;
+1 SET XBRC="PROC^BDPPHXD"
SET XBRP="PRINT^BDPPHXD"
SET XBNS="BDP"
SET XBRX="END^BDPPHXD"
+2 DO ^XBDBQUE
+3 DO END
+4 QUIT
PROC ;
+1 ;loop through file and tally by catgegory, skip inactive patients
+2 SET BDPJ=$JOB
SET BDPH=$HOROLOG
SET BDPTCNT=0
KILL BDPSCNT
+3 KILL ^XTMP("BDPPHXD",BDPJ,BDPH)
+4 DO XTMP^APCLOSUT("BDPPHXD","DESG PROVIDER REPORT")
+5 SET BDPX=0
FOR
SET BDPX=$ORDER(^BDPRECN("B",BDPX))
IF BDPX=""
QUIT
Begin DoDot:1
+6 IF $DATA(BDPPROVC)
IF BDPPROVC'=BDPX
QUIT
+7 SET BDPIEN=0
FOR
SET BDPIEN=$ORDER(^BDPRECN("B",BDPX,BDPIEN))
IF BDPIEN=""
QUIT
Begin DoDot:2
+8 SET DFN=$PIECE(^BDPRECN(BDPIEN,0),U,2)
+9 ;inactive patients
IF $PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,3)
QUIT
+10 SET BDPD=$$VAL^XBDIQ1(90360.1,BDPIEN,.01)
+11 SET ^XTMP("BDPPHXD",BDPJ,BDPH,"HITS",$$VAL^XBDIQ1(90360.1,BDPIEN,.01),$$VAL^XBDIQ1(90360.1,BDPIEN,.02),DFN,BDPIEN)=""
+12 SET BDPTCNT=BDPTCNT+1
SET BDPSCNT(BDPD)=$GET(BDPSCNT(BDPD))+1
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 QUIT
PRINT ;PRINT RECORDS BY DATE
+1 SET BDPPG=0
KILL BDPQUIT
+2 DO PAGEHEAD
+3 IF '$DATA(^XTMP("BDPPHXD",BDPJ,BDPH,"HITS"))
WRITE !,"No data to report."
DO END
QUIT
+4 SET BDPD=""
FOR
SET BDPD=$ORDER(^XTMP("BDPPHXD",BDPJ,BDPH,"HITS",BDPD))
IF BDPD=""!($DATA(BDPQUIT))
QUIT
Begin DoDot:1
+5 IF $Y>(IOSL-3)
DO PAGEHEAD
IF $DATA(BDPQUIT)
QUIT
+6 WRITE !!,"PROVIDER CATEGORY: ",BDPD
+7 SET BDPPN=0
FOR
SET BDPPN=$ORDER(^XTMP("BDPPHXD",BDPJ,BDPH,"HITS",BDPD,BDPPN))
IF BDPPN=""!($DATA(BDPQUIT))
QUIT
Begin DoDot:2
+8 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BDPPHXD",BDPJ,BDPH,"HITS",BDPD,BDPPN,DFN))
IF DFN=""!($DATA(BDPQUIT))
QUIT
Begin DoDot:3
+9 SET BDPI=0
FOR
SET BDPI=$ORDER(^XTMP("BDPPHXD",BDPJ,BDPH,"HITS",BDPD,BDPPN,DFN,BDPI))
IF BDPI=""!($DATA(BDPQUIT))
QUIT
Begin DoDot:4
+10 IF $Y>(IOSL-8)
DO PAGEHEAD
IF $DATA(BDPQUIT)
QUIT
+11 WRITE !!?3,"PATIENT NAME: ",$$VAL^XBDIQ1(90360.1,BDPI,.02),?50,"HEALTH RECORD: ",$$HRN^AUPNPAT(DFN,DUZ(2))
+12 WRITE !?3,"PROVIDER CATEGORY: ",$$VAL^XBDIQ1(90360.1,BDPI,.01)
+13 WRITE !?4,"CURRENT PROVIDER: ",$$VAL^XBDIQ1(90360.1,BDPI,.03)
+14 WRITE !?4,"DATE UPDATED: ",$$VAL^XBDIQ1(90360.1,BDPI,.05)," USER UPDATED: ",$$VAL^XBDIQ1(90360.1,BDPI,.04)
+15 WRITE !?6,"HISTORY DETAIL:"
+16 WRITE !?6,"PREVIOUS PROVIDER",?34,"START DATE",?45,"STOP DATE",?57,"UPDATED",?66,"UPDATED BY"
+17 SET BDPX=0
FOR
SET BDPX=$ORDER(^BDPRECN(BDPI,1,BDPX))
IF BDPX'=+BDPX
QUIT
Begin DoDot:5
+18 SET BDPN=^BDPRECN(BDPI,1,BDPX,0)
+19 ;I $P(BDPN,U,1)=$P(^BDPRECN(BDPI,0),U,3),$P(BDPN,U,2)=$P(^BDPRECN(BDPI,0),U,4),$P(BDPN,U,3)=$P(^BDPRECN(BDPI,0),U,5) Q ;already listed last one
+20 WRITE !?6,$EXTRACT($PIECE(^VA(200,$PIECE(BDPN,U,1),0),U,1),1,20),?34,$SELECT($PIECE(BDPN,U,4):$$DATE^BDPLMDSP($PIECE(BDPN,U,4)),1:"Unknown")
+21 WRITE ?45,$SELECT($PIECE(BDPN,U,5):$$DATE^BDPLMDSP($PIECE(BDPN,U,5)),1:""),?57,$$DATE^BDPLMDSP($PIECE(BDPN,U,3)),?66,$EXTRACT($PIECE(^VA(200,$PIECE(BDPN,U,2),0),U),1,12)
+22 ;W !?8,"OLD PROVIDER: ",$E($P(^VA(200,$P(BDPN,U,1),0),U,1),1,20),?42,$$DATE^BDPLMDSP($P(BDPN,U,3)),?53,"USER: ",$E($P(^VA(200,$P(BDPN,U,2),0),U,1),1,18)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+23 IF $Y>(IOSL-3)
DO PAGEHEAD
IF $DATA(BDPQUIT)
QUIT
+24 WRITE !,"Subcount: ",BDPSCNT(BDPD),!
End DoDot:1
+25 IF $DATA(BDPQUIT)
GOTO DONE
+26 ;I $Y>(IOSL-3) D PAGEHEAD G:$D(BDPQUIT) DONE
+27 ;W !!,"Total # of patients: ",BDPTCNT,!
DONE ;
+1 KILL ^XTMP("BDPPHXD",BDPJ,BDPH)
+2 DO END
+3 QUIT
END ;
+1 DO EN^XBVK("BDP")
+2 QUIT
+3 ;
PAGEHEAD ;
HEAD ;EP;HEADER
+1 IF $DATA(BDPDEM)!($DATA(BDPDEMM))
GOTO HEAD2
+2 IF 'BDPPG
GOTO HEAD1
HEAD2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BDPQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET BDPPG=BDPPG+1
+2 WRITE !,$$FMTE^XLFDT(DT),?70,"Page: ",BDPPG
+3 WRITE !,$$CTR("*****************************************************************",80)
+4 WRITE !,$$CTR("* DESIGNATED PROVIDER PATIENT HISTORY BY CATEGORY *",80)
+5 WRITE !,$$CTR("*****************************************************************",80)
+6 ;W !!,"PROVIDER CATEGORY",?22,"PATIENT NAME",?44,"LAST CURRENT PROVIDER",?68,"UPDATE DT"
+7 WRITE !,$$REPEAT^XLFSTR("-",79)
+8 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;
INFORM ;Report Explanation
+1 ;
+2 WRITE !?25,"******************************",!
+3 WRITE ?10,"This Report prints a Listing of patients by the provider category."
+4 WRITE !?10,"The report output includes a detailed history of that patient's"
+5 WRITE !?10,"provider history."
+6 WRITE !?25,"*****************************",!
+7 QUIT
