BXPARPPD ;IHS/OIT/FBD - PARAMETER AUDIT REPORTS - PARAMETER/PROVIDER/DATE RANGE ;
;;1.0;IHS EXTENSIONS TO KERNEL TOOLKIT;;Dec 19, 2013;Build 12
;
;
;REPORT OF PARAMETER VALUES FOR ONE OR MORE PROVIDERS OVER A USER-
;SPECIFIED DATE RANGE.
;
;PROVIDERS MAY BE SPECIFIED IN ONE OF TWO MANNERS:
; 1. MANUAL SELECTION BY USER OF ONE OR MORE PROVIDERS
; 2. SPECIFICATION OF AN EXISTING PROVIDER TAXONOMY
;
;REPORT WILL CONSIS OF THREE SECTIONS:
; 1. PARAMETER VALUES AT START OF DATE RANGE
; 2. PARAMETER VALUE CHANGES TRACKED THROUGH COURSE OF DATE RANGE
; 3. PARAMETER VALUES AT END OF DATE RANGE
;
EN ;EP
NEW BXPAEXIT,BXPSEL,BXBASE,BXPYEAR,DIRUT,DUOUT,X,Y,BXPABDT,BXPAEDT,BXPASEL
NEW BXPAPRV,ABORT,BXPABDT,BXPAEDT,BXPAITM,CT,DASH,L,NXDATE,P,PAR,PDATE,PIEN
NEW POP,PRV,PRDSC,ZTRTN,FLAG,IEN,QFL,TYPE,BXPBASE,BXPADT
S BXPAEXIT=0
D Q:BXPAEXIT
.NEW DIR
.W !!,"Select one of the following:",!
.W !?10,"1 User Defined Date Range"
.W !?10,"2 Quarter: January 1 - March 31"
.W !?10,"3 Quarter: April 1 - June 30"
.W !?10,"4 Quarter: July 1 - September 30"
.W !?10,"5 Quarter: October 1 - December 31"
.S DIR(0)="N^1:5:",DIR("A")="Select Report Period" K DA D ^DIR K DIR
.I $D(DIRUT) S BXPAEXIT=1 Q
.I $D(DUOUT) S BXPAEXIT=1 Q
.S BXPSEL=Y
I BXPSEL>1 D YR Q:BXPAEXIT
;
I BXPSEL=2 S BXPABDT=$E(BXPYEAR,1,3)_"0101",BXPAEDT=$E(BXPYEAR,1,3)_"0331"
I BXPSEL=3 S BXPABDT=$E(BXPYEAR,1,3)_"0401",BXPAEDT=$E(BXPYEAR,1,3)_"0630"
I BXPSEL=4 S BXPABDT=$E(BXPYEAR,1,3)_"0701",BXPAEDT=$E(BXPYEAR,1,3)_"0930"
I BXPSEL=5 S BXPABDT=$E(BXPYEAR,1,3)_"1001",BXPAEDT=$E(BXPYEAR,1,3)_"1231"
I BXPSEL=1 D DATESEL^BXPARUTL
;
D PROVSEL^BXPARUTL Q:BXPAEXIT ;SELECT PROVIDER(S)
D ITMSEL^BXPARUTL Q:BXPAEXIT ;SELECT AUDIT ITEM(S)
;
;SELECT DEVICE
S ZTRTN="TSK^BXPARPPD"
S ZTDESC="Parameter Audit Report"
S %ZIS="QM" D ^%ZIS Q:POP
I '$D(IO("Q")) K ZTDESC G @ZTRTN
S ZTIO=ION,ZTSAVE("*")=""
D ^%ZTLOAD
;
TSK ;QUEUED TASK ENTRY POINT FOR REPORT
S U="^"
D COMPILE
D PARS
D CLEANUP
Q
;
;
COMPILE ;COMPILE REPORT DATA
NEW PTR,DATE,INST,VALUE
K ^TMP("BXPADATA",$J)
; Get the priority levels of the parameter(s)
S PAR="" F S PAR=$O(BXPAITM(PAR)) Q:PAR="" D PPRI(PAR)
;
S PRV=""
F S PRV=$O(BXPAPRV(PRV)) Q:PRV="" D
.S BXPAUNM=BXPAPRV(PRV)
.S PAR="" F S PAR=$O(BXPAITM(PAR)) Q:PAR="" D
..D PAR(PAR)
Q
;
PAR(BXPAR) ;EP
NEW PTR,DATE,BXUSER,PLEV,PRI,BXPSOC,INST,VALUE,BXI,BXSRC,BXOP
S PTR=""
F S PTR=$O(^BXPA(9002026.01,"APAR",BXPAR,PTR)) Q:PTR="" D
.S BXOP=$P(^BXPA(9002026.01,PTR,0),U,4)
.S DATE=$P(^BXPA(9002026.01,PTR,0),U,1)\1 ;AUDIT RECORD DATE/TIME
.I DATE<BXPABDT,BXOP'="B" Q
.I DATE<BXPABDT,BXOP="B" S DATE=BXPABDT
.I DATE>BXPAEDT Q
.S BXUSER=$P(^BXPA(9002026.01,PTR,0),U,6),PIEN=$P(BXUSER,";",1),PLEV=$P(BXUSER,";",2)
.I PLEV="VA(200,",'$D(BXPAPRV(PIEN)) Q
.I PLEV="VA(200,",PRV'=PIEN Q
.S PRI=$P($G(BXPAITM(BXPAR,PLEV)),U,1) I PRI="" Q
.S PRDSC=$P(BXPAITM(BXPAR,PLEV),U,2)
.S BXPSOC=BXPAITM(BXPAR)
.S INST=$P(^BXPA(9002026.01,PTR,0),U,7) ;PARAMETER NAME
.S VALUE=$P(^BXPA(9002026.01,PTR,0),U,9) ;PARAMETER VALUE
.I BXPAR="ORK EDITABLE BY USER" D
..S BXPSOC="0:NO;1:YES"
.I BXPAR="ORQQPX COVER SHEET REMINDERS" S QFL=0 D Q:QFL
..S FLAG=$E(VALUE,1,1),TYPE=$E(VALUE,2,2),IEN=$E(VALUE,3,$L(VALUE))
..S VALUE=FLAG,BXPSOC="L:Lock;R:Remove;N:Normal"
..I TYPE="C" S QFL=1 Q
..I TYPE="R" S INST=$P(^PXD(811.9,IEN,0),U,1)
.I $L(VALUE)=1 D
..I BXPSOC="" Q
..F BXI=1:1:$L(BXPSOC,";") D
...S BXSRC=$P(BXPSOC,";",BXI)
...I $P(BXSRC,":",1)=VALUE S VALUE=$P(BXSRC,":",2) Q
.S ^TMP("BXPADATA",$J,BXPAUNM,BXPAR,INST,DATE,PRI,PRDSC)=VALUE_U_PTR
.S ^TMP("BXPADATA",$J,BXPAUNM)=PRV
Q
;
PPRI(BXPAR) ;EP - Parameter Priority
NEW BXPN,BXN,BXPRDS,BXPSOC,BXPRGL,BXPRGLRF,BXPRI
S BXPN=$O(^XTV(8989.51,"B",BXPAR,"")) I BXPN="" Q
S BXPSOC=$P($G(^XTV(8989.51,BXPN,1)),U,2),BXPAITM(BXPAR)=BXPSOC
D HIST^BXPARUTL(BXPAR,.BXPADT)
S BXN=0
F S BXN=$O(^XTV(8989.51,BXPN,30,BXN)) Q:'BXN D
.S BXPRI=$P(^XTV(8989.51,BXPN,30,BXN,0),U,1),BXPRGL=$P(^XTV(8989.51,BXPN,30,BXN,0),U,2)
.S BXPRDS=$P($G(^XTV(8989.518,BXPRGL,0)),U,2)
.S BXPRGLRF=$$STRIP^XLFSTR($$ROOT^DILFD(BXPRGL,""),"^")
.S BXPAITM(BXPAR,BXPRGLRF)=BXPRI_U_BXPRDS
Q
;
PARS ;
NEW USER,PRV,RANGE,PAR,BGDT,ENDT,PRI,LEVEL,VALUE,INST,DATE,DRANGE,HPRV,HPAR
S (P,L,ABORT,CT)=0
S RANGE=$$FMTE^XLFDT(BXPABDT,"5Z")_" - "_$$FMTE^XLFDT(BXPAEDT,"5Z")
U IO
I '$D(^TMP("BXPADATA",$J)) D Q
.S PRV=""
.F S PRV=$O(BXPAPRV(PRV)) Q:PRV="" D
..S HPRV=BXPAPRV(PRV),HPAR=""
..F S HPAR=$O(BXPAITM(HPAR)) Q:HPAR="" D
...S PAR=HPAR
...D HDRM
...W !,?10,"Not defined in audit log by this date",! S L=L+2
S USER=""
F S USER=$O(^TMP("BXPADATA",$J,USER)) Q:USER="" D I $G(ABORT)=1 Q
.S PRV=^TMP("BXPADATA",$J,USER)
.S PAR=""
.F S PAR=$O(^TMP("BXPADATA",$J,USER,PAR)) Q:PAR="" D W ! S L=L+1 I $G(ABORT)=1 Q
..NEW HPAR,HPRV
..S HPAR=PAR_" Parameter Report",HPRV="For provider: "_USER
..D HDRM I $G(ABORT)=1 Q
..S INST=""
..F S INST=$O(^TMP("BXPADATA",$J,USER,PAR,INST)) Q:INST="" D I $G(ABORT)=1 Q
...S DATE=""
...F S DATE=$O(^TMP("BXPADATA",$J,USER,PAR,INST,DATE)) Q:(DATE="")!(DATE>BXPAEDT)!(DATE<BXPABDT) D I $G(ABORT)=1 Q
....S NXDATE=$O(^TMP("BXPADATA",$J,USER,PAR,INST,DATE))
....S BGDT=$S(DATE'<PBGDT:DATE,1:PBGDT)
....I $G(ENDT)="" S ENDT=NXDATE S:NXDATE="" ENDT=BXPAEDT
....; Check if provider is inactive or terminated
....I $P(^VA(200,PRV,0),U,7)=1 S ENDT=$P($G(^VA(200,PRV,1.1)),U,1)\1
....I $P(^VA(200,PRV,0),U,11)'="" S ENDT=$P(^VA(200,PRV,0),U,11)
....I ENDT>DT S ENDT=DT
....S DRANGE=$$FMTE^XLFDT(BGDT,"5Z")_" - "_$$FMTE^XLFDT(ENDT,"5Z")
....I ENDT<BXPABDT S DRANGE="User not active"
....I PAR="ORQQPX COVER SHEET REMINDERS" D Q
..... S PRI=""
..... F S PRI=$O(^TMP("BXPADATA",$J,USER,PAR,INST,DATE,PRI),-1) Q:PRI="" D I $G(ABORT)=1 Q
......S LEVEL=$O(^TMP("BXPADATA",$J,USER,PAR,INST,DATE,PRI,""))
......S VALUE=$P(^TMP("BXPADATA",$J,USER,PAR,INST,DATE,PRI,LEVEL),U,1)
......W !,$E(INST,1,35),?40,LEVEL,?45,DRANGE,?70,VALUE S L=L+1
......I L+4>IOSL D HDRM Q:$G(ABORT)=1
....S PRI=$O(^TMP("BXPADATA",$J,USER,PAR,INST,DATE,"")) I PRI="" Q
....S LEVEL=$O(^TMP("BXPADATA",$J,USER,PAR,INST,DATE,PRI,""))
....S VALUE=$P(^TMP("BXPADATA",$J,USER,PAR,INST,DATE,PRI,LEVEL),U,1)
....W !,$E(INST,1,35),?40,LEVEL,?45,DRANGE,?70,VALUE S L=L+1
....K BGDT,ENDT
....I L+4>IOSL D HDRM Q:$G(ABORT)=1
Q
;
OUTPUT ;PRINT OUT REPORT
;N LINE,PAGE,PDATE,EFFDATE,INST,DASH,VALUE
S PDATE=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_(1700+$E(DT,1,3)) ;TODAY'S DATE IN A PRINTABLE FORMAT
;S EFFDATE=$E(BXPAEFDT,4,5)_"/"_$E(BXPAEFDT,6,7)_"/"_(1700+$E(BXPAEFDT,1,3)) ;EFFECTIVE DATE IN A PRINTABLE FORMAT
S DASH="",$P(DASH,"-",IOM)="" ;DASHED LINE FOR OUTPUT SEPARATOR
S PAGE=0 ;INITIALIZE REPORT PAGE COUNTER
S IOSL=$S(IOST["C-":IOSL-2,1:IOSL) ;FOR TERMINAL OUTPUT, LEAVE ROOM FOR A 'PAUSE' MESSAGE AT BOTTOM OF SCREEN
S LINE=IOSL ;REPORT LINE COUNTER
Q
;
HDRM ;EP - HEADER
S DASH="",$P(DASH,"-",IOM)=""
K DIR
S DIR(0)="E"
I $E(IOST,1,2)="C-",P D ^DIR I $G(DIRUT)=1!($G(DTOUT)=1) S ABORT=1 Q
I $E(IOST,1,2)="C-"!P W @IOF
S P=P+1,L=6,PDATE=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_(1700+$E(DT,1,3))
W !,?55,PDATE_" Page: "_P
W !,?80-$L(HPAR)\2,HPAR
W !,?80-$L(HPRV)\2,HPRV
W !,?80-$L(RANGE)\2,RANGE
D HIS(PAR)
W !,DASH,!
Q
;
YR ;EP
NEW BXBASE,DIR,DIRUT,DUOUT,Y
W !!,"Enter the Calendar Year for which report is to be run. Use a 4 digit",!,"year, e.g. 2014."
S BXBASE=$O(^BXPA(9002026.01,"B",""))\1,BXPBASE=$E(BXBASE,1,3)_"0000"
S DIR(0)="D^::EP"
S DIR("A")="Select Year"
S DIR("?")="This report is compiled for a period. Enter a valid year."
D ^DIR K DIR
I $D(DIRUT) S BXPAEXIT=1 Q
I $D(DUOUT) S BXPAEXIT=1 Q
I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G YR
S BXPYEAR=Y
I $E(BXPYEAR,1,3)<$E(BXPBASE,1,3) W !,"Year cannot be before Baseline date year." G YR
Q
;
LINEOUT ;OUTPUT A SINGLE LINE OF THE REPORT
S LINE=LINE+1
I LINE>IOSL D ;
.I (IOST["C-"),+PAGE D ;EXECUTE PAUSE MESSAGE WHEN BOTTOM OF SCREEN IS REACHED
..K DIR
..S DIR(0)="E" ;END-OF-PAGE
..D ^DIR
.D HEADER
W $E(INST,1,38),?41,VALUE,!
Q
;
;
I +PAGE!(IOST["C-") W @IOF ;SKIP FORM FEED ON FIRST PAGE, IF OUTPUT DEVICE NOT A CRT
S PAGE=PAGE+1
W "PARAMETER SETTINGS FOR",?24,BXPAUNM,?69,PDATE,!
W ?6,"IN EFFECT ON DATE",?24,EFFDATE,?71,"PAGE ",PAGE,!
W !,?5,"PARAMETER",?41,"VALUE",!
W DASH,!
S LINE=6
Q
;
;
CLEANUP ;CLEAN PARTITION BEFORE EXITING PROCESS
K BXPAEFDT,BXPAUSER,BXPAUNM,BXPAENT,BXPADATA,DIR
K ^TMP("BXPADATA",$J)
D ^%ZISC
Q
;
HIS(PAR) ;EP
NEW PDATE,PSTAT,CT,BHDRM
K BGDT,ENDT,PBGDT
S (PDATE,PBGDT)=BXPABDT,CT=0
F S PDATE=$O(BXPADT(PAR,PDATE)) Q:PDATE=""!(PDATE>BXPAEDT) D
.I CT=0 S BHDRM="*Auditing for this parameter was "
.S PSTAT=$O(BXPADT(PAR,PDATE,""),-1),CT=CT+1
.S BHDRM=BHDRM_PSTAT_" on "_$$FMTE^XLFDT(PDATE,"5Z")
.I $O(BXPADT(PAR,PDATE))'="" S BHDRM=BHDRM_" and "
.I PSTAT="DISABLED" S ENDT=PDATE
.I PSTAT="ENABLED" S PBGDT=PDATE
I $G(BHDRM)'="" W "*",!,?80-$L(BHDRM)\2,BHDRM
Q
BXPARPPD ;IHS/OIT/FBD - PARAMETER AUDIT REPORTS - PARAMETER/PROVIDER/DATE RANGE ;
+1 ;;1.0;IHS EXTENSIONS TO KERNEL TOOLKIT;;Dec 19, 2013;Build 12
+2 ;
+3 ;
+4 ;REPORT OF PARAMETER VALUES FOR ONE OR MORE PROVIDERS OVER A USER-
+5 ;SPECIFIED DATE RANGE.
+6 ;
+7 ;PROVIDERS MAY BE SPECIFIED IN ONE OF TWO MANNERS:
+8 ; 1. MANUAL SELECTION BY USER OF ONE OR MORE PROVIDERS
+9 ; 2. SPECIFICATION OF AN EXISTING PROVIDER TAXONOMY
+10 ;
+11 ;REPORT WILL CONSIS OF THREE SECTIONS:
+12 ; 1. PARAMETER VALUES AT START OF DATE RANGE
+13 ; 2. PARAMETER VALUE CHANGES TRACKED THROUGH COURSE OF DATE RANGE
+14 ; 3. PARAMETER VALUES AT END OF DATE RANGE
+15 ;
EN ;EP
+1 NEW BXPAEXIT,BXPSEL,BXBASE,BXPYEAR,DIRUT,DUOUT,X,Y,BXPABDT,BXPAEDT,BXPASEL
+2 NEW BXPAPRV,ABORT,BXPABDT,BXPAEDT,BXPAITM,CT,DASH,L,NXDATE,P,PAR,PDATE,PIEN
+3 NEW POP,PRV,PRDSC,ZTRTN,FLAG,IEN,QFL,TYPE,BXPBASE,BXPADT
+4 SET BXPAEXIT=0
+5 Begin DoDot:1
+6 NEW DIR
+7 WRITE !!,"Select one of the following:",!
+8 WRITE !?10,"1 User Defined Date Range"
+9 WRITE !?10,"2 Quarter: January 1 - March 31"
+10 WRITE !?10,"3 Quarter: April 1 - June 30"
+11 WRITE !?10,"4 Quarter: July 1 - September 30"
+12 WRITE !?10,"5 Quarter: October 1 - December 31"
+13 SET DIR(0)="N^1:5:"
SET DIR("A")="Select Report Period"
KILL DA
DO ^DIR
KILL DIR
+14 IF $DATA(DIRUT)
SET BXPAEXIT=1
QUIT
+15 IF $DATA(DUOUT)
SET BXPAEXIT=1
QUIT
+16 SET BXPSEL=Y
End DoDot:1
IF BXPAEXIT
QUIT
+17 IF BXPSEL>1
DO YR
IF BXPAEXIT
QUIT
+18 ;
+19 IF BXPSEL=2
SET BXPABDT=$EXTRACT(BXPYEAR,1,3)_"0101"
SET BXPAEDT=$EXTRACT(BXPYEAR,1,3)_"0331"
+20 IF BXPSEL=3
SET BXPABDT=$EXTRACT(BXPYEAR,1,3)_"0401"
SET BXPAEDT=$EXTRACT(BXPYEAR,1,3)_"0630"
+21 IF BXPSEL=4
SET BXPABDT=$EXTRACT(BXPYEAR,1,3)_"0701"
SET BXPAEDT=$EXTRACT(BXPYEAR,1,3)_"0930"
+22 IF BXPSEL=5
SET BXPABDT=$EXTRACT(BXPYEAR,1,3)_"1001"
SET BXPAEDT=$EXTRACT(BXPYEAR,1,3)_"1231"
+23 IF BXPSEL=1
DO DATESEL^BXPARUTL
+24 ;
+25 ;SELECT PROVIDER(S)
DO PROVSEL^BXPARUTL
IF BXPAEXIT
QUIT
+26 ;SELECT AUDIT ITEM(S)
DO ITMSEL^BXPARUTL
IF BXPAEXIT
QUIT
+27 ;
+28 ;SELECT DEVICE
+29 SET ZTRTN="TSK^BXPARPPD"
+30 SET ZTDESC="Parameter Audit Report"
+31 SET %ZIS="QM"
DO ^%ZIS
IF POP
QUIT
+32 IF '$DATA(IO("Q"))
KILL ZTDESC
GOTO @ZTRTN
+33 SET ZTIO=ION
SET ZTSAVE("*")=""
+34 DO ^%ZTLOAD
+35 ;
TSK ;QUEUED TASK ENTRY POINT FOR REPORT
+1 SET U="^"
+2 DO COMPILE
+3 DO PARS
+4 DO CLEANUP
+5 QUIT
+6 ;
+7 ;
COMPILE ;COMPILE REPORT DATA
+1 NEW PTR,DATE,INST,VALUE
+2 KILL ^TMP("BXPADATA",$JOB)
+3 ; Get the priority levels of the parameter(s)
+4 SET PAR=""
FOR
SET PAR=$ORDER(BXPAITM(PAR))
IF PAR=""
QUIT
DO PPRI(PAR)
+5 ;
+6 SET PRV=""
+7 FOR
SET PRV=$ORDER(BXPAPRV(PRV))
IF PRV=""
QUIT
Begin DoDot:1
+8 SET BXPAUNM=BXPAPRV(PRV)
+9 SET PAR=""
FOR
SET PAR=$ORDER(BXPAITM(PAR))
IF PAR=""
QUIT
Begin DoDot:2
+10 DO PAR(PAR)
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
PAR(BXPAR) ;EP
+1 NEW PTR,DATE,BXUSER,PLEV,PRI,BXPSOC,INST,VALUE,BXI,BXSRC,BXOP
+2 SET PTR=""
+3 FOR
SET PTR=$ORDER(^BXPA(9002026.01,"APAR",BXPAR,PTR))
IF PTR=""
QUIT
Begin DoDot:1
+4 SET BXOP=$PIECE(^BXPA(9002026.01,PTR,0),U,4)
+5 ;AUDIT RECORD DATE/TIME
SET DATE=$PIECE(^BXPA(9002026.01,PTR,0),U,1)\1
+6 IF DATE<BXPABDT
IF BXOP'="B"
QUIT
+7 IF DATE<BXPABDT
IF BXOP="B"
SET DATE=BXPABDT
+8 IF DATE>BXPAEDT
QUIT
+9 SET BXUSER=$PIECE(^BXPA(9002026.01,PTR,0),U,6)
SET PIEN=$PIECE(BXUSER,";",1)
SET PLEV=$PIECE(BXUSER,";",2)
+10 IF PLEV="VA(200,"
IF '$DATA(BXPAPRV(PIEN))
QUIT
+11 IF PLEV="VA(200,"
IF PRV'=PIEN
QUIT
+12 SET PRI=$PIECE($GET(BXPAITM(BXPAR,PLEV)),U,1)
IF PRI=""
QUIT
+13 SET PRDSC=$PIECE(BXPAITM(BXPAR,PLEV),U,2)
+14 SET BXPSOC=BXPAITM(BXPAR)
+15 ;PARAMETER NAME
SET INST=$PIECE(^BXPA(9002026.01,PTR,0),U,7)
+16 ;PARAMETER VALUE
SET VALUE=$PIECE(^BXPA(9002026.01,PTR,0),U,9)
+17 IF BXPAR="ORK EDITABLE BY USER"
Begin DoDot:2
+18 SET BXPSOC="0:NO;1:YES"
End DoDot:2
+19 IF BXPAR="ORQQPX COVER SHEET REMINDERS"
SET QFL=0
Begin DoDot:2
+20 SET FLAG=$EXTRACT(VALUE,1,1)
SET TYPE=$EXTRACT(VALUE,2,2)
SET IEN=$EXTRACT(VALUE,3,$LENGTH(VALUE))
+21 SET VALUE=FLAG
SET BXPSOC="L:Lock;R:Remove;N:Normal"
+22 IF TYPE="C"
SET QFL=1
QUIT
+23 IF TYPE="R"
SET INST=$PIECE(^PXD(811.9,IEN,0),U,1)
End DoDot:2
IF QFL
QUIT
+24 IF $LENGTH(VALUE)=1
Begin DoDot:2
+25 IF BXPSOC=""
QUIT
+26 FOR BXI=1:1:$LENGTH(BXPSOC,";")
Begin DoDot:3
+27 SET BXSRC=$PIECE(BXPSOC,";",BXI)
+28 IF $PIECE(BXSRC,":",1)=VALUE
SET VALUE=$PIECE(BXSRC,":",2)
QUIT
End DoDot:3
End DoDot:2
+29 SET ^TMP("BXPADATA",$JOB,BXPAUNM,BXPAR,INST,DATE,PRI,PRDSC)=VALUE_U_PTR
+30 SET ^TMP("BXPADATA",$JOB,BXPAUNM)=PRV
End DoDot:1
+31 QUIT
+32 ;
PPRI(BXPAR) ;EP - Parameter Priority
+1 NEW BXPN,BXN,BXPRDS,BXPSOC,BXPRGL,BXPRGLRF,BXPRI
+2 SET BXPN=$ORDER(^XTV(8989.51,"B",BXPAR,""))
IF BXPN=""
QUIT
+3 SET BXPSOC=$PIECE($GET(^XTV(8989.51,BXPN,1)),U,2)
SET BXPAITM(BXPAR)=BXPSOC
+4 DO HIST^BXPARUTL(BXPAR,.BXPADT)
+5 SET BXN=0
+6 FOR
SET BXN=$ORDER(^XTV(8989.51,BXPN,30,BXN))
IF 'BXN
QUIT
Begin DoDot:1
+7 SET BXPRI=$PIECE(^XTV(8989.51,BXPN,30,BXN,0),U,1)
SET BXPRGL=$PIECE(^XTV(8989.51,BXPN,30,BXN,0),U,2)
+8 SET BXPRDS=$PIECE($GET(^XTV(8989.518,BXPRGL,0)),U,2)
+9 SET BXPRGLRF=$$STRIP^XLFSTR($$ROOT^DILFD(BXPRGL,""),"^")
+10 SET BXPAITM(BXPAR,BXPRGLRF)=BXPRI_U_BXPRDS
End DoDot:1
+11 QUIT
+12 ;
PARS ;
+1 NEW USER,PRV,RANGE,PAR,BGDT,ENDT,PRI,LEVEL,VALUE,INST,DATE,DRANGE,HPRV,HPAR
+2 SET (P,L,ABORT,CT)=0
+3 SET RANGE=$$FMTE^XLFDT(BXPABDT,"5Z")_" - "_$$FMTE^XLFDT(BXPAEDT,"5Z")
+4 USE IO
+5 IF '$DATA(^TMP("BXPADATA",$JOB))
Begin DoDot:1
+6 SET PRV=""
+7 FOR
SET PRV=$ORDER(BXPAPRV(PRV))
IF PRV=""
QUIT
Begin DoDot:2
+8 SET HPRV=BXPAPRV(PRV)
SET HPAR=""
+9 FOR
SET HPAR=$ORDER(BXPAITM(HPAR))
IF HPAR=""
QUIT
Begin DoDot:3
+10 SET PAR=HPAR
+11 DO HDRM
+12 WRITE !,?10,"Not defined in audit log by this date",!
SET L=L+2
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+13 SET USER=""
+14 FOR
SET USER=$ORDER(^TMP("BXPADATA",$JOB,USER))
IF USER=""
QUIT
Begin DoDot:1
+15 SET PRV=^TMP("BXPADATA",$JOB,USER)
+16 SET PAR=""
+17 FOR
SET PAR=$ORDER(^TMP("BXPADATA",$JOB,USER,PAR))
IF PAR=""
QUIT
Begin DoDot:2
+18 NEW HPAR,HPRV
+19 SET HPAR=PAR_" Parameter Report"
SET HPRV="For provider: "_USER
+20 DO HDRM
IF $GET(ABORT)=1
QUIT
+21 SET INST=""
+22 FOR
SET INST=$ORDER(^TMP("BXPADATA",$JOB,USER,PAR,INST))
IF INST=""
QUIT
Begin DoDot:3
+23 SET DATE=""
+24 FOR
SET DATE=$ORDER(^TMP("BXPADATA",$JOB,USER,PAR,INST,DATE))
IF (DATE="")!(DATE>BXPAEDT)!(DATE<BXPABDT)
QUIT
Begin DoDot:4
+25 SET NXDATE=$ORDER(^TMP("BXPADATA",$JOB,USER,PAR,INST,DATE))
+26 SET BGDT=$SELECT(DATE'<PBGDT:DATE,1:PBGDT)
+27 IF $GET(ENDT)=""
SET ENDT=NXDATE
IF NXDATE=""
SET ENDT=BXPAEDT
+28 ; Check if provider is inactive or terminated
+29 IF $PIECE(^VA(200,PRV,0),U,7)=1
SET ENDT=$PIECE($GET(^VA(200,PRV,1.1)),U,1)\1
+30 IF $PIECE(^VA(200,PRV,0),U,11)'=""
SET ENDT=$PIECE(^VA(200,PRV,0),U,11)
+31 IF ENDT>DT
SET ENDT=DT
+32 SET DRANGE=$$FMTE^XLFDT(BGDT,"5Z")_" - "_$$FMTE^XLFDT(ENDT,"5Z")
+33 IF ENDT<BXPABDT
SET DRANGE="User not active"
+34 IF PAR="ORQQPX COVER SHEET REMINDERS"
Begin DoDot:5
+35 SET PRI=""
+36 FOR
SET PRI=$ORDER(^TMP("BXPADATA",$JOB,USER,PAR,INST,DATE,PRI),-1)
IF PRI=""
QUIT
Begin DoDot:6
+37 SET LEVEL=$ORDER(^TMP("BXPADATA",$JOB,USER,PAR,INST,DATE,PRI,""))
+38 SET VALUE=$PIECE(^TMP("BXPADATA",$JOB,USER,PAR,INST,DATE,PRI,LEVEL),U,1)
+39 WRITE !,$EXTRACT(INST,1,35),?40,LEVEL,?45,DRANGE,?70,VALUE
SET L=L+1
+40 IF L+4>IOSL
DO HDRM
IF $GET(ABORT)=1
QUIT
End DoDot:6
IF $GET(ABORT)=1
QUIT
End DoDot:5
QUIT
+41 SET PRI=$ORDER(^TMP("BXPADATA",$JOB,USER,PAR,INST,DATE,""))
IF PRI=""
QUIT
+42 SET LEVEL=$ORDER(^TMP("BXPADATA",$JOB,USER,PAR,INST,DATE,PRI,""))
+43 SET VALUE=$PIECE(^TMP("BXPADATA",$JOB,USER,PAR,INST,DATE,PRI,LEVEL),U,1)
+44 WRITE !,$EXTRACT(INST,1,35),?40,LEVEL,?45,DRANGE,?70,VALUE
SET L=L+1
+45 KILL BGDT,ENDT
+46 IF L+4>IOSL
DO HDRM
IF $GET(ABORT)=1
QUIT
End DoDot:4
IF $GET(ABORT)=1
QUIT
End DoDot:3
IF $GET(ABORT)=1
QUIT
End DoDot:2
WRITE !
SET L=L+1
IF $GET(ABORT)=1
QUIT
End DoDot:1
IF $GET(ABORT)=1
QUIT
+47 QUIT
+48 ;
OUTPUT ;PRINT OUT REPORT
+1 ;N LINE,PAGE,PDATE,EFFDATE,INST,DASH,VALUE
+2 ;TODAY'S DATE IN A PRINTABLE FORMAT
SET PDATE=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_(1700+$EXTRACT(DT,1,3))
+3 ;S EFFDATE=$E(BXPAEFDT,4,5)_"/"_$E(BXPAEFDT,6,7)_"/"_(1700+$E(BXPAEFDT,1,3)) ;EFFECTIVE DATE IN A PRINTABLE FORMAT
+4 ;DASHED LINE FOR OUTPUT SEPARATOR
SET DASH=""
SET $PIECE(DASH,"-",IOM)=""
+5 ;INITIALIZE REPORT PAGE COUNTER
SET PAGE=0
+6 ;FOR TERMINAL OUTPUT, LEAVE ROOM FOR A 'PAUSE' MESSAGE AT BOTTOM OF SCREEN
SET IOSL=$SELECT(IOST["C-":IOSL-2,1:IOSL)
+7 ;REPORT LINE COUNTER
SET LINE=IOSL
+8 QUIT
+9 ;
HDRM ;EP - HEADER
+1 SET DASH=""
SET $PIECE(DASH,"-",IOM)=""
+2 KILL DIR
+3 SET DIR(0)="E"
+4 IF $EXTRACT(IOST,1,2)="C-"
IF P
DO ^DIR
IF $GET(DIRUT)=1!($GET(DTOUT)=1)
SET ABORT=1
QUIT
+5 IF $EXTRACT(IOST,1,2)="C-"!P
WRITE @IOF
+6 SET P=P+1
SET L=6
SET PDATE=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_(1700+$EXTRACT(DT,1,3))
+7 WRITE !,?55,PDATE_" Page: "_P
+8 WRITE !,?80-$LENGTH(HPAR)\2,HPAR
+9 WRITE !,?80-$LENGTH(HPRV)\2,HPRV
+10 WRITE !,?80-$LENGTH(RANGE)\2,RANGE
+11 DO HIS(PAR)
+12 WRITE !,DASH,!
+13 QUIT
+14 ;
YR ;EP
+1 NEW BXBASE,DIR,DIRUT,DUOUT,Y
+2 WRITE !!,"Enter the Calendar Year for which report is to be run. Use a 4 digit",!,"year, e.g. 2014."
+3 SET BXBASE=$ORDER(^BXPA(9002026.01,"B",""))\1
SET BXPBASE=$EXTRACT(BXBASE,1,3)_"0000"
+4 SET DIR(0)="D^::EP"
+5 SET DIR("A")="Select Year"
+6 SET DIR("?")="This report is compiled for a period. Enter a valid year."
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
SET BXPAEXIT=1
QUIT
+9 IF $DATA(DUOUT)
SET BXPAEXIT=1
QUIT
+10 IF $EXTRACT(Y,4,7)'="0000"
WRITE !!,"Please enter a year only!",!
GOTO YR
+11 SET BXPYEAR=Y
+12 IF $EXTRACT(BXPYEAR,1,3)<$EXTRACT(BXPBASE,1,3)
WRITE !,"Year cannot be before Baseline date year."
GOTO YR
+13 QUIT
+14 ;
LINEOUT ;OUTPUT A SINGLE LINE OF THE REPORT
+1 SET LINE=LINE+1
+2 ;
IF LINE>IOSL
Begin DoDot:1
+3 ;EXECUTE PAUSE MESSAGE WHEN BOTTOM OF SCREEN IS REACHED
IF (IOST["C-")
IF +PAGE
Begin DoDot:2
+4 KILL DIR
+5 ;END-OF-PAGE
SET DIR(0)="E"
+6 DO ^DIR
End DoDot:2
+7 DO HEADER
End DoDot:1
+8 WRITE $EXTRACT(INST,1,38),?41,VALUE,!
+9 QUIT
+10 ;
+11 ;
+1 ;SKIP FORM FEED ON FIRST PAGE, IF OUTPUT DEVICE NOT A CRT
IF +PAGE!(IOST["C-")
WRITE @IOF
+2 SET PAGE=PAGE+1
+3 WRITE "PARAMETER SETTINGS FOR",?24,BXPAUNM,?69,PDATE,!
+4 WRITE ?6,"IN EFFECT ON DATE",?24,EFFDATE,?71,"PAGE ",PAGE,!
+5 WRITE !,?5,"PARAMETER",?41,"VALUE",!
+6 WRITE DASH,!
+7 SET LINE=6
+8 QUIT
+9 ;
+10 ;
CLEANUP ;CLEAN PARTITION BEFORE EXITING PROCESS
+1 KILL BXPAEFDT,BXPAUSER,BXPAUNM,BXPAENT,BXPADATA,DIR
+2 KILL ^TMP("BXPADATA",$JOB)
+3 DO ^%ZISC
+4 QUIT
+5 ;
HIS(PAR) ;EP
+1 NEW PDATE,PSTAT,CT,BHDRM
+2 KILL BGDT,ENDT,PBGDT
+3 SET (PDATE,PBGDT)=BXPABDT
SET CT=0
+4 FOR
SET PDATE=$ORDER(BXPADT(PAR,PDATE))
IF PDATE=""!(PDATE>BXPAEDT)
QUIT
Begin DoDot:1
+5 IF CT=0
SET BHDRM="*Auditing for this parameter was "
+6 SET PSTAT=$ORDER(BXPADT(PAR,PDATE,""),-1)
SET CT=CT+1
+7 SET BHDRM=BHDRM_PSTAT_" on "_$$FMTE^XLFDT(PDATE,"5Z")
+8 IF $ORDER(BXPADT(PAR,PDATE))'=""
SET BHDRM=BHDRM_" and "
+9 IF PSTAT="DISABLED"
SET ENDT=PDATE
+10 IF PSTAT="ENABLED"
SET PBGDT=PDATE
End DoDot:1
+11 IF $GET(BHDRM)'=""
WRITE "*",!,?80-$LENGTH(BHDRM)\2,BHDRM
+12 QUIT
