BXPARUTL ;IHS/OIT/FBD - PARAMETER AUDIT REPORT UTILITIES ;
;;1.0;IHS EXTENSIONS TO KERNEL TOOLKIT;;Dec 19, 2013;Build 12
;
;
DATESEL ;SPECIFY DATE RANGE OF REPORT
K BXPABDT,BXPAEDT
NEW Y
S BXPABDT=$$DATE("B") ;BEGINNING DATE OF DATE RANGE
I +BXPABDT'>0 S BXPAEXIT=1 Q
S BXPAEDT=$$DATE("E") ;ENDING DATE OF DATE RANGE
I +BXPAEDT'>0 S BXPAEXIT=1
Q
;
DATE(SPEC) ;SELECT DATE
;INPUT:
; SPEC DATE SPECIFICATION
; "B" = BEGINNING DATE OF DATE RANGE
; "E" = ENDING DATE OF DATE RANGE
;RETURNED VALUE:
; POSITIVE VALUE = SELECTED DATE (FM INTERNAL FORMAT)
; ZERO (0) VALUE = NO DATE SPECIFIED
;
NEW DIR,DATE,PROMPT,BXBSLD
I $G(DT)="" D DT^DICRW
S DATE=0
S PROMPT=$S(SPEC="B":"beginning",SPEC="E":"ending")
I SPEC="B" D ;OPEN RANGE ON BEGINNING DATE,
.S BXBSLD=$O(^BXPA(9002026.01,"B",""))\1
.S DIR(0)="D^"_BXBSLD_":"_DT_".2359:AETX"
E D ;BUT ENDING DATE MUST FOLLOW BEGINNING DATE
.S DIR(0)="D^"_BXPABDT_":"_DT_".2359:AETX"
S DIR("A")="Enter "_PROMPT_" date of report date range: "
D ^DIR
I +Y S DATE=+Y
E S:$D(DIRUT) BXPAEXIT=1 ;SET FLAG IF USER ABORTED ENTRY
Q DATE
;
PROVSEL ;PROVIDER SELECTION
K BXPAPRV
NEW DIR,X,Y,BXPAPIEN,BXPAUNM,BXPASEL
S DIR(0)="S^IP:Individual Provider;SEL:Selected Providers (User Defined);TAX:Provider Taxonomy List"
S DIR("A")="Enter Selection" D ^DIR
S BXPASEL=Y
I BXPASEL="SEL" D PROVMAN
I BXPASEL="IP" D PROVPICK
I BXPASEL="TAX" D PROVTAX
I $D(DIRUT) S BXPAEXIT=1 Q
Q
;
VALPROV(IEN,BDATE,EDATE) ;FUNCTION TO CHECK IF A
Q
;
ITMSEL ;EP - Select Audit items
NEW ITMDONE,BXIEN,BXPINM
K BXPAITM
S ITMDONE=0,BXPAEXIT=0
W !!,"Parameter Selection",!
W !,"You may select one or more Parameters."
W !,"Press the <Enter> key without entering a name to conclude the selection process."
W !,"Enter ""^"" to abort the selection process.",!
F D Q:ITMDONE
.D ITMPICK Q:ITMDONE
.S BXPAITM(BXPINM)=""
I 'BXPAEXIT,'$D(BXPAITM) S BXPAEXIT=1 Q
Q
;
ITMPICK ;
NEW DIC,DA,GLOBROOT,MSG
S BXPAEXIT=0
S DIC="^BXPA(9002026.02,",DIC(0)="AEMQ"
S DIC("A")="Select a Parameter: "
D ^DIC K DIC
I +Y>0 D ;PROCESS SELECTION
.S BXIEN=+Y
.S BXPINM=$P(^BXPA(9002026.02,BXIEN,0),U,1)
E D ;EXITING - SET FLAGS FOR WHY
.S ITMDONE=1
.S:$D(DTOUT) BXPAEXIT=1
Q
;
PROVMAN ;MANUAL PROVIDER SELECTION - USER SELECTS ONE OR MORE PROVIDERS INDIVIDUALLY
S BXPAEXIT=0,PRVDONE=0 ;FLAG FOR ABORTING PROCESS
W !!,"Manual Provider Selection",!
W !,"You may select one or more providers."
W !,"Press the <Enter> key without entering a name to conclude the selection process."
W !,"Enter ""^"" to abort the selection process.",!
F D Q:PRVDONE
.D PROVPICK Q:PRVDONE
.S BXPAPRV(BXPAPIEN)=BXPAUNM
I 'BXPAEXIT,'$D(BXPAPRV) S BXPAEXIT=1
Q
;
PROVPICK ;SELECT AN INDIVIDUAL PROVIDER
;EXIT VALUE(S):
; BPXAUSER>0 BPXAUSER = FILE 200 IEN
; BPXAUSER=0 USER CONCLUDED QUERY PROCESS
; BPXAEXIT=1 USER ABORTED QUERY PROCESS
NEW DIC,DA,GLOBROOT,MSG
S BXPAEXIT=0
S (DIC,GLOBROOT)="^VA(200,"
S DIC(0)="AEMQ"
S DIC("A")="Select a provider: "
S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U),+Y))"
D ^DIC K DIC
I +Y>0 D ;PROCESS SELECTION
.S BXPAPIEN=+Y ;NEW USER FILE #200 RECORD POINTER
.S BXPAUNM=$P(^VA(200,BXPAPIEN,0),U,1) ;USER NAME
.S BXPAPRV(BXPAPIEN)=BXPAUNM
E D ;EXITING - SET FLAGS FOR WHY
.S PRVDONE=1
.S:$D(DTOUT) BXPAEXIT=1
I 'BXPAEXIT,'$D(BXPAPRV) S BXPAEXIT=1
Q
;
PROVTAX ;SELECT PROVIDERS BASED ON AN EXISTING PROVIDER TAXONOMY
NEW DIC,DA,BXN,BXTAX,BXPAUNM,BXPAPIEN
K BXPAPROV
S DIC="^ATXAX("
S DIC(0)="AEMQ"
S DIC("S")="I $P(^ATXAX(+Y,0),U,15)=200"
S DIC("A")="Select provider taxonomy: "
D ^DIC K DIC
I +Y>0 D ;SCAN SPECIFIED TAXONOMY & EXTRACT SPECIFIED PROVIDERS
.S BXTAX=+Y,BXN=0
.F S BXN=$O(^ATXAX(BXTAX,21,BXN)) Q:'BXN D
..S BXPAPIEN=$P(^ATXAX(BXTAX,21,BXN,0),U,1)
..S BXPAUNM=$P($G(^VA(200,BXPAPIEN,0)),U,1)
..I BXPAUNM'="" S BXPAPRV(BXPAPIEN)=BXPAUNM
E D ;EXITING - SET FLAGS FOR WHY
.S PRVDONE=1
.S:$D(DTOUT) BXPAEXIT=1
I 'BXPAEXIT,'$D(BXPAPRV) S BXPAEXIT=1
Q
;
HIST(BXPAPRM,BXPADT) ;EP-History of parameter
NEW PARIEN,BXI,DATE,STAT
S PARIEN=$O(^BXPA(9002026.02,"B",BXPAPRM,"")) I PARIEN="" Q
S BXI=0
F S BXI=$O(^BXPA(9002026.02,PARIEN,11,BXI)) Q:'BXI D
.S DATE=$P(^BXPA(9002026.02,PARIEN,11,BXI,0),U,1)\1
.NEW DA,IENS
.S DA(1)=PARIEN,DA=BXI,IENS=$$IENS^DILF(.DA)
.S STAT=$$GET1^DIQ(9002026.21101,IENS,1,"E")
.S BXPADT(BXPAPRM,DATE,STAT)=""
Q
BXPARUTL ;IHS/OIT/FBD - PARAMETER AUDIT REPORT UTILITIES ;
+1 ;;1.0;IHS EXTENSIONS TO KERNEL TOOLKIT;;Dec 19, 2013;Build 12
+2 ;
+3 ;
DATESEL ;SPECIFY DATE RANGE OF REPORT
+1 KILL BXPABDT,BXPAEDT
+2 NEW Y
+3 ;BEGINNING DATE OF DATE RANGE
SET BXPABDT=$$DATE("B")
+4 IF +BXPABDT'>0
SET BXPAEXIT=1
QUIT
+5 ;ENDING DATE OF DATE RANGE
SET BXPAEDT=$$DATE("E")
+6 IF +BXPAEDT'>0
SET BXPAEXIT=1
+7 QUIT
+8 ;
DATE(SPEC) ;SELECT DATE
+1 ;INPUT:
+2 ; SPEC DATE SPECIFICATION
+3 ; "B" = BEGINNING DATE OF DATE RANGE
+4 ; "E" = ENDING DATE OF DATE RANGE
+5 ;RETURNED VALUE:
+6 ; POSITIVE VALUE = SELECTED DATE (FM INTERNAL FORMAT)
+7 ; ZERO (0) VALUE = NO DATE SPECIFIED
+8 ;
+9 NEW DIR,DATE,PROMPT,BXBSLD
+10 IF $GET(DT)=""
DO DT^DICRW
+11 SET DATE=0
+12 SET PROMPT=$SELECT(SPEC="B":"beginning",SPEC="E":"ending")
+13 ;OPEN RANGE ON BEGINNING DATE,
IF SPEC="B"
Begin DoDot:1
+14 SET BXBSLD=$ORDER(^BXPA(9002026.01,"B",""))\1
+15 SET DIR(0)="D^"_BXBSLD_":"_DT_".2359:AETX"
End DoDot:1
+16 ;BUT ENDING DATE MUST FOLLOW BEGINNING DATE
IF '$TEST
Begin DoDot:1
+17 SET DIR(0)="D^"_BXPABDT_":"_DT_".2359:AETX"
End DoDot:1
+18 SET DIR("A")="Enter "_PROMPT_" date of report date range: "
+19 DO ^DIR
+20 IF +Y
SET DATE=+Y
+21 ;SET FLAG IF USER ABORTED ENTRY
IF '$TEST
IF $DATA(DIRUT)
SET BXPAEXIT=1
+22 QUIT DATE
+23 ;
PROVSEL ;PROVIDER SELECTION
+1 KILL BXPAPRV
+2 NEW DIR,X,Y,BXPAPIEN,BXPAUNM,BXPASEL
+3 SET DIR(0)="S^IP:Individual Provider;SEL:Selected Providers (User Defined);TAX:Provider Taxonomy List"
+4 SET DIR("A")="Enter Selection"
DO ^DIR
+5 SET BXPASEL=Y
+6 IF BXPASEL="SEL"
DO PROVMAN
+7 IF BXPASEL="IP"
DO PROVPICK
+8 IF BXPASEL="TAX"
DO PROVTAX
+9 IF $DATA(DIRUT)
SET BXPAEXIT=1
QUIT
+10 QUIT
+11 ;
VALPROV(IEN,BDATE,EDATE) ;FUNCTION TO CHECK IF A
+1 QUIT
+2 ;
ITMSEL ;EP - Select Audit items
+1 NEW ITMDONE,BXIEN,BXPINM
+2 KILL BXPAITM
+3 SET ITMDONE=0
SET BXPAEXIT=0
+4 WRITE !!,"Parameter Selection",!
+5 WRITE !,"You may select one or more Parameters."
+6 WRITE !,"Press the <Enter> key without entering a name to conclude the selection process."
+7 WRITE !,"Enter ""^"" to abort the selection process.",!
+8 FOR
Begin DoDot:1
+9 DO ITMPICK
IF ITMDONE
QUIT
+10 SET BXPAITM(BXPINM)=""
End DoDot:1
IF ITMDONE
QUIT
+11 IF 'BXPAEXIT
IF '$DATA(BXPAITM)
SET BXPAEXIT=1
QUIT
+12 QUIT
+13 ;
ITMPICK ;
+1 NEW DIC,DA,GLOBROOT,MSG
+2 SET BXPAEXIT=0
+3 SET DIC="^BXPA(9002026.02,"
SET DIC(0)="AEMQ"
+4 SET DIC("A")="Select a Parameter: "
+5 DO ^DIC
KILL DIC
+6 ;PROCESS SELECTION
IF +Y>0
Begin DoDot:1
+7 SET BXIEN=+Y
+8 SET BXPINM=$PIECE(^BXPA(9002026.02,BXIEN,0),U,1)
End DoDot:1
+9 ;EXITING - SET FLAGS FOR WHY
IF '$TEST
Begin DoDot:1
+10 SET ITMDONE=1
+11 IF $DATA(DTOUT)
SET BXPAEXIT=1
End DoDot:1
+12 QUIT
+13 ;
PROVMAN ;MANUAL PROVIDER SELECTION - USER SELECTS ONE OR MORE PROVIDERS INDIVIDUALLY
+1 ;FLAG FOR ABORTING PROCESS
SET BXPAEXIT=0
SET PRVDONE=0
+2 WRITE !!,"Manual Provider Selection",!
+3 WRITE !,"You may select one or more providers."
+4 WRITE !,"Press the <Enter> key without entering a name to conclude the selection process."
+5 WRITE !,"Enter ""^"" to abort the selection process.",!
+6 FOR
Begin DoDot:1
+7 DO PROVPICK
IF PRVDONE
QUIT
+8 SET BXPAPRV(BXPAPIEN)=BXPAUNM
End DoDot:1
IF PRVDONE
QUIT
+9 IF 'BXPAEXIT
IF '$DATA(BXPAPRV)
SET BXPAEXIT=1
+10 QUIT
+11 ;
PROVPICK ;SELECT AN INDIVIDUAL PROVIDER
+1 ;EXIT VALUE(S):
+2 ; BPXAUSER>0 BPXAUSER = FILE 200 IEN
+3 ; BPXAUSER=0 USER CONCLUDED QUERY PROCESS
+4 ; BPXAEXIT=1 USER ABORTED QUERY PROCESS
+5 NEW DIC,DA,GLOBROOT,MSG
+6 SET BXPAEXIT=0
+7 SET (DIC,GLOBROOT)="^VA(200,"
+8 SET DIC(0)="AEMQ"
+9 SET DIC("A")="Select a provider: "
+10 SET DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U),+Y))"
+11 DO ^DIC
KILL DIC
+12 ;PROCESS SELECTION
IF +Y>0
Begin DoDot:1
+13 ;NEW USER FILE #200 RECORD POINTER
SET BXPAPIEN=+Y
+14 ;USER NAME
SET BXPAUNM=$PIECE(^VA(200,BXPAPIEN,0),U,1)
+15 SET BXPAPRV(BXPAPIEN)=BXPAUNM
End DoDot:1
+16 ;EXITING - SET FLAGS FOR WHY
IF '$TEST
Begin DoDot:1
+17 SET PRVDONE=1
+18 IF $DATA(DTOUT)
SET BXPAEXIT=1
End DoDot:1
+19 IF 'BXPAEXIT
IF '$DATA(BXPAPRV)
SET BXPAEXIT=1
+20 QUIT
+21 ;
PROVTAX ;SELECT PROVIDERS BASED ON AN EXISTING PROVIDER TAXONOMY
+1 NEW DIC,DA,BXN,BXTAX,BXPAUNM,BXPAPIEN
+2 KILL BXPAPROV
+3 SET DIC="^ATXAX("
+4 SET DIC(0)="AEMQ"
+5 SET DIC("S")="I $P(^ATXAX(+Y,0),U,15)=200"
+6 SET DIC("A")="Select provider taxonomy: "
+7 DO ^DIC
KILL DIC
+8 ;SCAN SPECIFIED TAXONOMY & EXTRACT SPECIFIED PROVIDERS
IF +Y>0
Begin DoDot:1
+9 SET BXTAX=+Y
SET BXN=0
+10 FOR
SET BXN=$ORDER(^ATXAX(BXTAX,21,BXN))
IF 'BXN
QUIT
Begin DoDot:2
+11 SET BXPAPIEN=$PIECE(^ATXAX(BXTAX,21,BXN,0),U,1)
+12 SET BXPAUNM=$PIECE($GET(^VA(200,BXPAPIEN,0)),U,1)
+13 IF BXPAUNM'=""
SET BXPAPRV(BXPAPIEN)=BXPAUNM
End DoDot:2
End DoDot:1
+14 ;EXITING - SET FLAGS FOR WHY
IF '$TEST
Begin DoDot:1
+15 SET PRVDONE=1
+16 IF $DATA(DTOUT)
SET BXPAEXIT=1
End DoDot:1
+17 IF 'BXPAEXIT
IF '$DATA(BXPAPRV)
SET BXPAEXIT=1
+18 QUIT
+19 ;
HIST(BXPAPRM,BXPADT) ;EP-History of parameter
+1 NEW PARIEN,BXI,DATE,STAT
+2 SET PARIEN=$ORDER(^BXPA(9002026.02,"B",BXPAPRM,""))
IF PARIEN=""
QUIT
+3 SET BXI=0
+4 FOR
SET BXI=$ORDER(^BXPA(9002026.02,PARIEN,11,BXI))
IF 'BXI
QUIT
Begin DoDot:1
+5 SET DATE=$PIECE(^BXPA(9002026.02,PARIEN,11,BXI,0),U,1)\1
+6 NEW DA,IENS
+7 SET DA(1)=PARIEN
SET DA=BXI
SET IENS=$$IENS^DILF(.DA)
+8 SET STAT=$$GET1^DIQ(9002026.21101,IENS,1,"E")
+9 SET BXPADT(BXPAPRM,DATE,STAT)=""
End DoDot:1
+10 QUIT
