BQIIPTST ;GDIT/HS/ALA-IPC Routine for Testing ; 29 Nov 2011 2:23 PM
;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
;
;
EN ;EP
NEW PROD,DIRUT,DUOUT
S PROD=$$PROD^XUPROD()
I PROD D Q
. D EN^DDIOL("This is a PRODUCTION account. You cannot run this program.","","!!?8")
NEW DIR,X,Y,DATE,BQDT
S DIR("A")="Enter Month and Year"
S DIR("A",1)="Remember that the CRS measures will only aggregate based on what their"
S DIR("A",2)="current values are since the Nightly or Weekly job has run."
S DIR(0)="D^3130100:"_$E(DT,1,5)_"00"_":EM"
D ^DIR
I $G(DIRUT)="^"!($G(DUOUT)="^")!(Y="^") Q
S DATE=Y,BQDT=Y(0)
D EN^DDIOL("Running . . . for "_BQDT,"","!!?12")
D EN^BQIIPMON(DATE)
D EN^DDIOL("Done . . .","","!!?12")
Q
;
BEG ;EP
NEW ZTDESC,%ZIS,ZTIO,ZTSK
S ZTDESC="MISMATCHED PROVIDER REPORT",ZTRTN="RPT^BQIIPTST"
S %ZIS="QM" D ^%ZIS Q:POP
I '$D(IO("Q")) K ZTDESC G @ZTRTN
S ZTIO=ION,ZTSAVE("*")=""
D ^%ZTLOAD
Q
;
RPT ;EP - Report
NEW BQIRUN,P,L,ABORT,CT,DFN,DSPM,DPCP
S BQIRUN=$$HTE^XLFDT($H,1)
S (P,L,ABORT,CT)=0
U IO D HDR I $G(ABORT)=1 Q
S DFN=0
F S DFN=$O(^AUPNPAT(DFN)) Q:'DFN D Q:$G(ABORT)=1
. S DSPM=$$DPCP^BQIULPT(DFN)
. I $G(^AUPNPAT(DFN,0))="" Q
. S DPCP=$P(^AUPNPAT(DFN,0),U,14)
. I $P(DSPM,U,1)=DPCP Q
. I L+4>IOSL D HDR Q:$G(ABORT)=1
. W !,$P($G(^DPT(DFN,0)),U,1),?40,$$HRNL^BQIULPT(DFN) S L=L+1
. W !,?10,$S(DPCP'="":$P($G(^VA(200,DPCP,0)),U,1),1:""),?40,$S($P(DSPM,U,1)'="":$P(DSPM,U,2),1:"")
. S L=L+1
. I L+4>IOSL D HDR Q:$G(ABORT)=1
;
I '$G(ABORT) W !,"<End of Report>" I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR
D ^%ZISC
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
HDR ; Header
I $E(IOST,1,2)="C-",P S DIR(0)="E" D ^DIR I $G(DIRUT) S ABORT=1 Q
I $E(IOST,1,2)="C-"!P W @IOF
S P=P+1,L=5
W "MISMATCHED PRIMARY CARE PROVIDERS",?90,"Run Date: ",BQIRUN,?124,"Page ",$J(P,3)
W !,"Patient Name",?30,"HRNs"
W !,?10,"Primary Care Provider",?40,"Designated PCP"
W !,$TR($J(" ",IOM)," ","-"),!
Q
;
FM ;EP - FileMan Report
NEW DIC,FLDS,BY,FR,TO
S DIC="^AUPNPAT("
S FLDS="!.14"
S BY="+.14",FR="",TO=""
D EN1^DIP
Q
BQIIPTST ;GDIT/HS/ALA-IPC Routine for Testing ; 29 Nov 2011 2:23 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
+2 ;
+3 ;
EN ;EP
+1 NEW PROD,DIRUT,DUOUT
+2 SET PROD=$$PROD^XUPROD()
+3 IF PROD
Begin DoDot:1
+4 DO EN^DDIOL("This is a PRODUCTION account. You cannot run this program.","","!!?8")
End DoDot:1
QUIT
+5 NEW DIR,X,Y,DATE,BQDT
+6 SET DIR("A")="Enter Month and Year"
+7 SET DIR("A",1)="Remember that the CRS measures will only aggregate based on what their"
+8 SET DIR("A",2)="current values are since the Nightly or Weekly job has run."
+9 SET DIR(0)="D^3130100:"_$EXTRACT(DT,1,5)_"00"_":EM"
+10 DO ^DIR
+11 IF $GET(DIRUT)="^"!($GET(DUOUT)="^")!(Y="^")
QUIT
+12 SET DATE=Y
SET BQDT=Y(0)
+13 DO EN^DDIOL("Running . . . for "_BQDT,"","!!?12")
+14 DO EN^BQIIPMON(DATE)
+15 DO EN^DDIOL("Done . . .","","!!?12")
+16 QUIT
+17 ;
BEG ;EP
+1 NEW ZTDESC,%ZIS,ZTIO,ZTSK
+2 SET ZTDESC="MISMATCHED PROVIDER REPORT"
SET ZTRTN="RPT^BQIIPTST"
+3 SET %ZIS="QM"
DO ^%ZIS
IF POP
QUIT
+4 IF '$DATA(IO("Q"))
KILL ZTDESC
GOTO @ZTRTN
+5 SET ZTIO=ION
SET ZTSAVE("*")=""
+6 DO ^%ZTLOAD
+7 QUIT
+8 ;
RPT ;EP - Report
+1 NEW BQIRUN,P,L,ABORT,CT,DFN,DSPM,DPCP
+2 SET BQIRUN=$$HTE^XLFDT($HOROLOG,1)
+3 SET (P,L,ABORT,CT)=0
+4 USE IO
DO HDR
IF $GET(ABORT)=1
QUIT
+5 SET DFN=0
+6 FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF 'DFN
QUIT
Begin DoDot:1
+7 SET DSPM=$$DPCP^BQIULPT(DFN)
+8 IF $GET(^AUPNPAT(DFN,0))=""
QUIT
+9 SET DPCP=$PIECE(^AUPNPAT(DFN,0),U,14)
+10 IF $PIECE(DSPM,U,1)=DPCP
QUIT
+11 IF L+4>IOSL
DO HDR
IF $GET(ABORT)=1
QUIT
+12 WRITE !,$PIECE($GET(^DPT(DFN,0)),U,1),?40,$$HRNL^BQIULPT(DFN)
SET L=L+1
+13 WRITE !,?10,$SELECT(DPCP'="":$PIECE($GET(^VA(200,DPCP,0)),U,1),1:""),?40,$SELECT($PIECE(DSPM,U,1)'="":$PIECE(DSPM,U,2),1:"")
+14 SET L=L+1
+15 IF L+4>IOSL
DO HDR
IF $GET(ABORT)=1
QUIT
End DoDot:1
IF $GET(ABORT)=1
QUIT
+16 ;
+17 IF '$GET(ABORT)
WRITE !,"<End of Report>"
IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
+18 DO ^%ZISC
+19 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+20 QUIT
+21 ;
HDR ; Header
+1 IF $EXTRACT(IOST,1,2)="C-"
IF P
SET DIR(0)="E"
DO ^DIR
IF $GET(DIRUT)
SET ABORT=1
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"!P
WRITE @IOF
+3 SET P=P+1
SET L=5
+4 WRITE "MISMATCHED PRIMARY CARE PROVIDERS",?90,"Run Date: ",BQIRUN,?124,"Page ",$JUSTIFY(P,3)
+5 WRITE !,"Patient Name",?30,"HRNs"
+6 WRITE !,?10,"Primary Care Provider",?40,"Designated PCP"
+7 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-"),!
+8 QUIT
+9 ;
FM ;EP - FileMan Report
+1 NEW DIC,FLDS,BY,FR,TO
+2 SET DIC="^AUPNPAT("
+3 SET FLDS="!.14"
+4 SET BY="+.14"
SET FR=""
SET TO=""
+5 DO EN1^DIP
+6 QUIT
