- 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
