- 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
