- 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
