IBCNAU3 ;ALB/KML/AWC - USER EDIT REPORT (PRINT) ;6-APRIL-2015
;;2.0;INTEGRATED BILLING;**528,602,664,737**;21-MAR-94;Build 19
;;Per VA Directive 6402, this routine should not be modified.
;
; Required variable input: ALLUSERS, ALLINS, PLANS, ALLPLANS, EXCEL, ALLPYRS, REPTYP,
; ^TMP("IBINC",$J)
; ^TMP("IBPYR",$J) ;/vd-IB*2*664 - Added this array
; ^TMP("IBUSER",$J)
; DATE("START") and DATE("END") required array elements if all dates not selected
;
; REPTYP (1=Ins. Company/Plans only; 2=Payers only; 3=both, Ins. Company/Plans & Payers)
;
;IB*732/CKB - references to 'eIV Payer' should be changed to 'Payer' in order
; to include 'IIU payers'
Q
;
;EN(ALLPLANS,PLANS) ;
;/vd-IB*2*664 - Replaced the above line with the line below
EN(ALLPLANS,PLANS,ALLPYRS,REPTYP) ;
; Print the report.
;
;I EXCEL D EXCEL(PLANS) Q
;/vd-IB*2*664 - Replaced the line above with the line below
;I +$G(EXCEL) D EXCEL(PLANS,ALLPYRS,REPTYP) Q
I +$G(EXCEL) D EXCEL(PLANS,ALLPYRS,REPTYP) G ENOUT ; IB*737/DTG new exit point for cleanup
N IBI,IBJ,IBK,IBL,IBM,IB01,IB02,IBQUIT,IBPAG,IBPD,IBHDT
S (IB02,IBQUIT,IBPAG)=0
S IBHDT=$$FMTE^XLFDT($$NOW^XLFDT())
D PRINT G ENOUT:IBQUIT ; IB*737/DTG added tag to better control the quit.
G ENX
;
PRINT ; IB*737/DTG new tag for better control of quits
;D HDR(ALLPLANS,PLANS)
;I '$D(^TMP("IBPR",$J)) W !!,"User Edits do not exist per the selected filters." D PAUSE Q
;
;F IB01=0,1 F S IB02=$O(^TMP("IBPR",$J,IB01,IB02)) Q:'IB02 Q:IBQUIT S IBPD=$G(^TMP("IBPR",$J,IB01,IB02)) D Q:IBQUIT
;. I $Y>(IOSL-5) D PAUSE Q:IBQUIT D HDR(ALLPLANS,PLANS)
;. D PLAN
;vd-IB*2*664 - Replaced the above lines with the lines below:
;/IB*2*664 - Beginning of new code
I REPTYP'=2 D Q:IBQUIT ; report for ins cos/plans or both was selected
. D HDR(ALLPLANS,PLANS)
. I '$D(^TMP("IBPR",$J)) W !!,"User Edits do not exist per the selected filters.",!! Q ;IB*737/DTG added additional line feed at end
. ;
. F IB01=0,1 F S IB02=$O(^TMP("IBPR",$J,IB01,IB02)) Q:'IB02 Q:IBQUIT S IBPD=$G(^TMP("IBPR",$J,IB01,IB02)) D Q:IBQUIT
. . I $Y>(IOSL-5) D PAUSE Q:IBQUIT D HDR(ALLPLANS,PLANS)
. . D PLAN
;I REPTYP=1,'$D(^TMP("IBPR",$J)) G ENX
I REPTYP=1,'$D(^TMP("IBPR",$J)) Q ; IB*737/DTG quit back
;
;IB*737/CKB
I REPTYP'=1 D Q:IBQUIT ; report for payers or both was selected
. I REPTYP=3 D PAUSE
. D HDR2(ALLPYRS)
. I '$D(^TMP("IBPR2",$J)) W !!,"User Edits do not exist per the selected filters.",!! Q ;IB*737/DTG added additional line feed at end
. ;
. F IB01=0,1 F S IB02=$O(^TMP("IBPR2",$J,IB01,IB02)) Q:'IB02 Q:IBQUIT S IBPD=$G(^TMP("IBPR2",$J,IB01,IB02)) D Q:IBQUIT
. . I $Y>(IOSL-5) D PAUSE Q:IBQUIT D HDR2(ALLPYRS)
. . D PAYER
;I REPTYP=2,'$D(^TMP("IBPR",$J)) G ENX
I REPTYP=2,'$D(^TMP("IBPR",$J)) Q ; IB*737/DTG quit back
;
Q ; IB*737/DTG quit back
;
ENX ;/vd-IB*2.0*664 - End of new code.
W "END OF REPORT" D PAUSE
;Q
G ENOUT ; IB*737/DTG new exit point for cleanup
;
;
HDR(ALLPLANS,PLANS) ; Print REPORT header - /vd-IB*2.0*664 Replaced the variable IOM with the new variable WIDTH
I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
S IBPAG=IBPAG+1
W !,"USER EDIT REPORT"
W ?WIDTH-34,IBHDT,?WIDTH-10,"Page: ",IBPAG
;IB*737/DTG reduce indent by 5 for ins line, 3 for user line
;W !?5,"Insurance Company"
W !,"Insurance Company"
;I PLANS W ?42,"Group Name"
I PLANS W ?37,"Group Name"
;W !!?5,"User",?25,"Date/Time of Change",?49,"Modified Field",?75,"Previous Value of Data",?100,"Modified Value of Data"
W !!,?2,"User",?22,"Date/Time of Change",?46,"Modified Field",?72,"Previous Value of Data"
W ?103,"Modified Value of Data"
W !,$TR($J(" ",WIDTH)," ","_"),!
Q
;
PLAN ; Print plan information.
N USER,DATE
S USER=$$GET1^DIQ(200,$P(IBPD,U,3)_",",.01)
S DATE=$$FMTE^XLFDT($P(IBPD,U,4),2),DATE=$TR(DATE,"@"," ")
;IB*737/DTG reduce indent by 5 for ins line, 3 for user line
;W !?5,$P(IBPD,U),?42,$S('IB01:"",1:$P(IBPD,U,2))
W !,$P(IBPD,U)
I PLANS W ?37,$S($P(IBPD,U,8)=36:"INS CO EDITS",'IB01:"",1:$P(IBPD,U,2)) ; IB*737/DTG co. level if file 36 flag
;W !?5,USER,?25,DATE,?49,$P(IBPD,U,7),?75,$S($P(IBPD,U,5)="":"<no previous value>",1:$P(IBPD,U,5)),?100,$P(IBPD,U,6),!!
W !,?2,USER,?22,DATE,?46,$P(IBPD,U,7),?72,$S($P(IBPD,U,5)="":"<no previous value>",1:$E($P(IBPD,U,5),1,29))
W ?103,$E($P(IBPD,U,6),1,29),!!
Q
;
;/vd-IB*2*664 - Beginning of new code
HDR2(ALLPYRS) ; Print REPORT header - /vd-IB*2.0*664 Replaced the variable IOM with the new variable WIDTH
I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
S IBPAG=IBPAG+1
W !,"USER EDIT REPORT"
W ?WIDTH-34,IBHDT,?WIDTH-10,"Page: ",IBPAG
;IB*737/DTG reduce indent by 5 for ins line, 3 for user line
;W !?5,"Payer"
W !,"Payer"
;W !!?5,"User",?25,"Date/Time of Change",?49,"Modified Field",?75,"Previous Value of Data",?100,"Modified Value of Data"
W !!,?2,"User",?22,"Date/Time of Change",?46,"Modified Field"
W ?72,"Previous Value of Data",?103,"Modified Value of Data"
W !,$TR($J(" ",WIDTH)," ","_"),!
Q
;
PAYER ; Print plan information.
N USER,DATE
S USER=$$GET1^DIQ(200,$P(IBPD,U,2)_",",.01)
S DATE=$$FMTE^XLFDT($P(IBPD,U,3),2),DATE=$TR(DATE,"@"," ")
;IB*737/DTG reduce indent by 5 for ins line, 3 for user line
;W !?5,$P(IBPD,U),?42,$S('IB01:"",1:$P(IBPD,U,2))
W !,$P(IBPD,U)
I PLANS W ?37,$S($P(IBPD,U,8)=36:"INS CO EDITS",'IB01:"",1:$P(IBPD,U,2))
;W !?5,USER,?25,DATE,?49,$P(IBPD,U,6),?75,$S($P(IBPD,U,4)="":"<no previous value>",1:$P(IBPD,U,4)),?100,$P(IBPD,U,5),!!
W !,?2,USER,?22,DATE,?46,$P(IBPD,U,6),?72,$S($P(IBPD,U,4)="":"<no previous value>",1:$E($P(IBPD,U,4),1,29))
W ?103,$E($P(IBPD,U,5),1,29),!!
Q
;/vd-IB*2*664 - End of new code.
;
PAUSE ; Pause for screen output.
Q:$E(IOST,1,2)'["C-"
W !
S DIR(0)="E" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S IBQUIT=1 K DIRUT,DTOUT,DUOUT
Q
;
;EXCEL(PLANS) ; user selected format that can be viewed in MS Excel
;/vd-IB*2*664 - Replaced the above line with the following line
EXCEL(PLANS,ALLPYRS,REPTYP) ; user selected format that can be viewed in MS Excel
N IBI,IBJ,IBK,IBL,IBM,IB01,IB02,USER,DATE
N IBPL ;IB*737/DTG for use with plan/group
S (IB01,IB02)=0
; IB*602/HN ; Add report headers to Excel Spreadsheets
W !,"USER EDIT REPORT^"_$$FMTE^XLFDT($$NOW^XLFDT,1)
; IB*602/HN end
;/vd-IB*2*664 - Beginning of new code.
I REPTYP=1 W !,"For Insurance Companies/Plans"
;IB*737/CKB
I REPTYP=2 W !,"For Payers"
I REPTYP=3 W !,"For Both Insurance Companies/Plans and Payers"
;/vd-IB*2*664 - End of new code.
;
I REPTYP'=2 D
. I PLANS W !,"Insurance Company^Group Name^User^Date/Time of Change^Modified Field^Previous Value of Data^Modified Value of Data",!
. E W !,"Insurance Company^User^Date/Time of Change^Modified Field^Previous Value of Data^Modified Value of Data",!
;
;IB*737/CKB - Insurance Company, no data found
I REPTYP'=2 I '$D(^TMP("IBPR",$J)) W !,"User Edits do not exist per the selected filters.",!
;
S IBQUIT=0 ; IB*737/DTG for page check if crt
F IB01=0,1 F S IB02=$O(^TMP("IBPR",$J,IB01,IB02)) Q:'IB02 S IBPD=$G(^TMP("IBPR",$J,IB01,IB02)) D Q:IBQUIT ;IB*737/DTG screen check
. S USER=$$GET1^DIQ(200,$P(IBPD,U,3)_",",.01)
. S DATE=$$FMTE^XLFDT($P(IBPD,U,4),2)
. ;IB*737/DTG change to if else
. ;I IB01=0 W $P(IBPD,U)_U_USER_U_DATE_U_$P(IBPD,U,7)_U_$S($P(IBPD,U,5)="":"<no previous value>",1:$P(IBPD,U,5))_U_$P(IBPD,U,6)
. ;E W $P(IBPD,U)_U_$P(IBPD,U,2)_U_USER_U_DATE_U_$P(IBPD,U,7)_U_$S($P(IBPD,U,5)="":"<no previous value>",1:$P(IBPD,U,5))_U_$P(IBPD,U,6)
. I IB01=0 D
. . W $P(IBPD,U)_U_USER_U_DATE_U_$P(IBPD,U,7)_U
. . W $S($P(IBPD,U,5)="":"<no previous value>",1:$P(IBPD,U,5))_U_$P(IBPD,U,6)
. I IB01'=0 D
. . W $P(IBPD,U)_U
. . S IBPL="",IBPL=$S($P(IBPD,U,8)=36:"INS CO EDITS",1:$P(IBPD,U,2))
. . S:IBPL="NO PLANS SELECTED" IBPL="" W IBPL_U
. . W USER_U_DATE_U_$P(IBPD,U,7)_U_$S($P(IBPD,U,5)="":"<no previous value>",1:$P(IBPD,U,5))_U
. . W $P(IBPD,U,6)
. W !
. I ($Y#($G(IOSL)-5))=0 S IBQUIT=0 D EXLCK Q:IBQUIT ;IB*737/DTG screen check
;
I IBQUIT Q ;IB*737/DTG quit if screen and exit.
;
;/vd-IB*2.0*664 - Beginning of new code for Payer data.
I REPTYP'=1 D
. ;IB*737/CKB
. W !,"Payer^User^Date/Time of Change^Modified Field^Previous Value of Data^Modified Value of Data",!
. ;IB*737/CKB - Payer, no data found
. I '$D(^TMP("IBPR2",$J)) W !,"User Edits do not exist per the selected filters.",! Q
. F IB01=0,1 F S IB02=$O(^TMP("IBPR2",$J,IB01,IB02)) Q:'IB02 S IBPD=$G(^TMP("IBPR2",$J,IB01,IB02)) D Q:IBQUIT ;IB*737/DTG screen check
. . S USER=$$GET1^DIQ(200,$P(IBPD,U,2)_",",.01)
. . S DATE=$$FMTE^XLFDT($P(IBPD,U,3),2)
. . W $P(IBPD,U)_U_USER_U_DATE_U_$P(IBPD,U,6)_U_$S($P(IBPD,U,4)="":"<no previous value>",1:$P(IBPD,U,4))_U_$P(IBPD,U,5)
. . W !
. . I ($Y#($G(IOSL)-5))=0 S IBQUIT=0 D EXLCK Q:IBQUIT
;/vd-IB*2.0*664 - End of new code for Payer data.
;
; -- write to screen
;I $E(IOST,1,2)["C-" W !,"[END OF REPORT]",! S DIR("A")="Press RETURN to continue" D PAUSE
EXEOR ;IB*737/CKB - called if no data was found
W "[END OF REPORT]",!
D EXLCK ;IB*737/DTG include EOR on excel queued check for pause
Q
;
EXLCK ; IB*737/DTG new tag for excel to check for pause
;
I $E(IOST,1,2)["C-" S DIR("A")="Press RETURN to continue" D PAUSE W !
Q
;
ENOUT ; IB*737/DTG new TAG to cleanup temp files on exit.
;
;clear temp files
K ^TMP("IBPYR",$J),^TMP("IBINC",$J),^TMP("IBUSER",$J),^TMP("IBPR",$J),^TMP("IBPR2",$J),^TMP($J)
K ^TMP("IBPRINS",$J) ; IB*737/DTG to track which DIA(36,"B",INSIENS have been picked up
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNAU3 9660 printed Jan 18, 2025@03:14:56 Page 2
IBCNAU3 ;ALB/KML/AWC - USER EDIT REPORT (PRINT) ;6-APRIL-2015
+1 ;;2.0;INTEGRATED BILLING;**528,602,664,737**;21-MAR-94;Build 19
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Required variable input: ALLUSERS, ALLINS, PLANS, ALLPLANS, EXCEL, ALLPYRS, REPTYP,
+5 ; ^TMP("IBINC",$J)
+6 ; ^TMP("IBPYR",$J) ;/vd-IB*2*664 - Added this array
+7 ; ^TMP("IBUSER",$J)
+8 ; DATE("START") and DATE("END") required array elements if all dates not selected
+9 ;
+10 ; REPTYP (1=Ins. Company/Plans only; 2=Payers only; 3=both, Ins. Company/Plans & Payers)
+11 ;
+12 ;IB*732/CKB - references to 'eIV Payer' should be changed to 'Payer' in order
+13 ; to include 'IIU payers'
+14 QUIT
+15 ;
+16 ;EN(ALLPLANS,PLANS) ;
+17 ;/vd-IB*2*664 - Replaced the above line with the line below
EN(ALLPLANS,PLANS,ALLPYRS,REPTYP) ;
+1 ; Print the report.
+2 ;
+3 ;I EXCEL D EXCEL(PLANS) Q
+4 ;/vd-IB*2*664 - Replaced the line above with the line below
+5 ;I +$G(EXCEL) D EXCEL(PLANS,ALLPYRS,REPTYP) Q
+6 ; IB*737/DTG new exit point for cleanup
IF +$GET(EXCEL)
DO EXCEL(PLANS,ALLPYRS,REPTYP)
GOTO ENOUT
+7 NEW IBI,IBJ,IBK,IBL,IBM,IB01,IB02,IBQUIT,IBPAG,IBPD,IBHDT
+8 SET (IB02,IBQUIT,IBPAG)=0
+9 SET IBHDT=$$FMTE^XLFDT($$NOW^XLFDT())
+10 ; IB*737/DTG added tag to better control the quit.
DO PRINT
if IBQUIT
GOTO ENOUT
+11 GOTO ENX
+12 ;
PRINT ; IB*737/DTG new tag for better control of quits
+1 ;D HDR(ALLPLANS,PLANS)
+2 ;I '$D(^TMP("IBPR",$J)) W !!,"User Edits do not exist per the selected filters." D PAUSE Q
+3 ;
+4 ;F IB01=0,1 F S IB02=$O(^TMP("IBPR",$J,IB01,IB02)) Q:'IB02 Q:IBQUIT S IBPD=$G(^TMP("IBPR",$J,IB01,IB02)) D Q:IBQUIT
+5 ;. I $Y>(IOSL-5) D PAUSE Q:IBQUIT D HDR(ALLPLANS,PLANS)
+6 ;. D PLAN
+7 ;vd-IB*2*664 - Replaced the above lines with the lines below:
+8 ;/IB*2*664 - Beginning of new code
+9 ; report for ins cos/plans or both was selected
IF REPTYP'=2
Begin DoDot:1
+10 DO HDR(ALLPLANS,PLANS)
+11 ;IB*737/DTG added additional line feed at end
IF '$DATA(^TMP("IBPR",$JOB))
WRITE !!,"User Edits do not exist per the selected filters.",!!
QUIT
+12 ;
+13 FOR IB01=0,1
FOR
SET IB02=$ORDER(^TMP("IBPR",$JOB,IB01,IB02))
if 'IB02
QUIT
if IBQUIT
QUIT
SET IBPD=$GET(^TMP("IBPR",$JOB,IB01,IB02))
Begin DoDot:2
+14 IF $Y>(IOSL-5)
DO PAUSE
if IBQUIT
QUIT
DO HDR(ALLPLANS,PLANS)
+15 DO PLAN
End DoDot:2
if IBQUIT
QUIT
End DoDot:1
if IBQUIT
QUIT
+16 ;I REPTYP=1,'$D(^TMP("IBPR",$J)) G ENX
+17 ; IB*737/DTG quit back
IF REPTYP=1
IF '$DATA(^TMP("IBPR",$JOB))
QUIT
+18 ;
+19 ;IB*737/CKB
+20 ; report for payers or both was selected
IF REPTYP'=1
Begin DoDot:1
+21 IF REPTYP=3
DO PAUSE
+22 DO HDR2(ALLPYRS)
+23 ;IB*737/DTG added additional line feed at end
IF '$DATA(^TMP("IBPR2",$JOB))
WRITE !!,"User Edits do not exist per the selected filters.",!!
QUIT
+24 ;
+25 FOR IB01=0,1
FOR
SET IB02=$ORDER(^TMP("IBPR2",$JOB,IB01,IB02))
if 'IB02
QUIT
if IBQUIT
QUIT
SET IBPD=$GET(^TMP("IBPR2",$JOB,IB01,IB02))
Begin DoDot:2
+26 IF $Y>(IOSL-5)
DO PAUSE
if IBQUIT
QUIT
DO HDR2(ALLPYRS)
+27 DO PAYER
End DoDot:2
if IBQUIT
QUIT
End DoDot:1
if IBQUIT
QUIT
+28 ;I REPTYP=2,'$D(^TMP("IBPR",$J)) G ENX
+29 ; IB*737/DTG quit back
IF REPTYP=2
IF '$DATA(^TMP("IBPR",$JOB))
QUIT
+30 ;
+31 ; IB*737/DTG quit back
QUIT
+32 ;
ENX ;/vd-IB*2.0*664 - End of new code.
+1 WRITE "END OF REPORT"
DO PAUSE
+2 ;Q
+3 ; IB*737/DTG new exit point for cleanup
GOTO ENOUT
+4 ;
+5 ;
HDR(ALLPLANS,PLANS) ; Print REPORT header - /vd-IB*2.0*664 Replaced the variable IOM with the new variable WIDTH
+1 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
WRITE @IOF
+2 SET IBPAG=IBPAG+1
+3 WRITE !,"USER EDIT REPORT"
+4 WRITE ?WIDTH-34,IBHDT,?WIDTH-10,"Page: ",IBPAG
+5 ;IB*737/DTG reduce indent by 5 for ins line, 3 for user line
+6 ;W !?5,"Insurance Company"
+7 WRITE !,"Insurance Company"
+8 ;I PLANS W ?42,"Group Name"
+9 IF PLANS
WRITE ?37,"Group Name"
+10 ;W !!?5,"User",?25,"Date/Time of Change",?49,"Modified Field",?75,"Previous Value of Data",?100,"Modified Value of Data"
+11 WRITE !!,?2,"User",?22,"Date/Time of Change",?46,"Modified Field",?72,"Previous Value of Data"
+12 WRITE ?103,"Modified Value of Data"
+13 WRITE !,$TRANSLATE($JUSTIFY(" ",WIDTH)," ","_"),!
+14 QUIT
+15 ;
PLAN ; Print plan information.
+1 NEW USER,DATE
+2 SET USER=$$GET1^DIQ(200,$PIECE(IBPD,U,3)_",",.01)
+3 SET DATE=$$FMTE^XLFDT($PIECE(IBPD,U,4),2)
SET DATE=$TRANSLATE(DATE,"@"," ")
+4 ;IB*737/DTG reduce indent by 5 for ins line, 3 for user line
+5 ;W !?5,$P(IBPD,U),?42,$S('IB01:"",1:$P(IBPD,U,2))
+6 WRITE !,$PIECE(IBPD,U)
+7 ; IB*737/DTG co. level if file 36 flag
IF PLANS
WRITE ?37,$SELECT($PIECE(IBPD,U,8)=36:"INS CO EDITS",'IB01:"",1:$PIECE(IBPD,U,2))
+8 ;W !?5,USER,?25,DATE,?49,$P(IBPD,U,7),?75,$S($P(IBPD,U,5)="":"<no previous value>",1:$P(IBPD,U,5)),?100,$P(IBPD,U,6),!!
+9 WRITE !,?2,USER,?22,DATE,?46,$PIECE(IBPD,U,7),?72,$SELECT($PIECE(IBPD,U,5)="":"<no previous value>",1:$EXTRACT($PIECE(IBPD,U,5),1,29))
+10 WRITE ?103,$EXTRACT($PIECE(IBPD,U,6),1,29),!!
+11 QUIT
+12 ;
+13 ;/vd-IB*2*664 - Beginning of new code
HDR2(ALLPYRS) ; Print REPORT header - /vd-IB*2.0*664 Replaced the variable IOM with the new variable WIDTH
+1 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
WRITE @IOF
+2 SET IBPAG=IBPAG+1
+3 WRITE !,"USER EDIT REPORT"
+4 WRITE ?WIDTH-34,IBHDT,?WIDTH-10,"Page: ",IBPAG
+5 ;IB*737/DTG reduce indent by 5 for ins line, 3 for user line
+6 ;W !?5,"Payer"
+7 WRITE !,"Payer"
+8 ;W !!?5,"User",?25,"Date/Time of Change",?49,"Modified Field",?75,"Previous Value of Data",?100,"Modified Value of Data"
+9 WRITE !!,?2,"User",?22,"Date/Time of Change",?46,"Modified Field"
+10 WRITE ?72,"Previous Value of Data",?103,"Modified Value of Data"
+11 WRITE !,$TRANSLATE($JUSTIFY(" ",WIDTH)," ","_"),!
+12 QUIT
+13 ;
PAYER ; Print plan information.
+1 NEW USER,DATE
+2 SET USER=$$GET1^DIQ(200,$PIECE(IBPD,U,2)_",",.01)
+3 SET DATE=$$FMTE^XLFDT($PIECE(IBPD,U,3),2)
SET DATE=$TRANSLATE(DATE,"@"," ")
+4 ;IB*737/DTG reduce indent by 5 for ins line, 3 for user line
+5 ;W !?5,$P(IBPD,U),?42,$S('IB01:"",1:$P(IBPD,U,2))
+6 WRITE !,$PIECE(IBPD,U)
+7 IF PLANS
WRITE ?37,$SELECT($PIECE(IBPD,U,8)=36:"INS CO EDITS",'IB01:"",1:$PIECE(IBPD,U,2))
+8 ;W !?5,USER,?25,DATE,?49,$P(IBPD,U,6),?75,$S($P(IBPD,U,4)="":"<no previous value>",1:$P(IBPD,U,4)),?100,$P(IBPD,U,5),!!
+9 WRITE !,?2,USER,?22,DATE,?46,$PIECE(IBPD,U,6),?72,$SELECT($PIECE(IBPD,U,4)="":"<no previous value>",1:$EXTRACT($PIECE(IBPD,U,4),1,29))
+10 WRITE ?103,$EXTRACT($PIECE(IBPD,U,5),1,29),!!
+11 QUIT
+12 ;/vd-IB*2*664 - End of new code.
+13 ;
PAUSE ; Pause for screen output.
+1 if $EXTRACT(IOST,1,2)'["C-"
QUIT
+2 WRITE !
+3 SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)!($DATA(DUOUT))
SET IBQUIT=1
KILL DIRUT,DTOUT,DUOUT
+4 QUIT
+5 ;
+6 ;EXCEL(PLANS) ; user selected format that can be viewed in MS Excel
+7 ;/vd-IB*2*664 - Replaced the above line with the following line
EXCEL(PLANS,ALLPYRS,REPTYP) ; user selected format that can be viewed in MS Excel
+1 NEW IBI,IBJ,IBK,IBL,IBM,IB01,IB02,USER,DATE
+2 ;IB*737/DTG for use with plan/group
NEW IBPL
+3 SET (IB01,IB02)=0
+4 ; IB*602/HN ; Add report headers to Excel Spreadsheets
+5 WRITE !,"USER EDIT REPORT^"_$$FMTE^XLFDT($$NOW^XLFDT,1)
+6 ; IB*602/HN end
+7 ;/vd-IB*2*664 - Beginning of new code.
+8 IF REPTYP=1
WRITE !,"For Insurance Companies/Plans"
+9 ;IB*737/CKB
+10 IF REPTYP=2
WRITE !,"For Payers"
+11 IF REPTYP=3
WRITE !,"For Both Insurance Companies/Plans and Payers"
+12 ;/vd-IB*2*664 - End of new code.
+13 ;
+14 IF REPTYP'=2
Begin DoDot:1
+15 IF PLANS
WRITE !,"Insurance Company^Group Name^User^Date/Time of Change^Modified Field^Previous Value of Data^Modified Value of Data",!
+16 IF '$TEST
WRITE !,"Insurance Company^User^Date/Time of Change^Modified Field^Previous Value of Data^Modified Value of Data",!
End DoDot:1
+17 ;
+18 ;IB*737/CKB - Insurance Company, no data found
+19 IF REPTYP'=2
IF '$DATA(^TMP("IBPR",$JOB))
WRITE !,"User Edits do not exist per the selected filters.",!
+20 ;
+21 ; IB*737/DTG for page check if crt
SET IBQUIT=0
+22 ;IB*737/DTG screen check
FOR IB01=0,1
FOR
SET IB02=$ORDER(^TMP("IBPR",$JOB,IB01,IB02))
if 'IB02
QUIT
SET IBPD=$GET(^TMP("IBPR",$JOB,IB01,IB02))
Begin DoDot:1
+23 SET USER=$$GET1^DIQ(200,$PIECE(IBPD,U,3)_",",.01)
+24 SET DATE=$$FMTE^XLFDT($PIECE(IBPD,U,4),2)
+25 ;IB*737/DTG change to if else
+26 ;I IB01=0 W $P(IBPD,U)_U_USER_U_DATE_U_$P(IBPD,U,7)_U_$S($P(IBPD,U,5)="":"<no previous value>",1:$P(IBPD,U,5))_U_$P(IBPD,U,6)
+27 ;E W $P(IBPD,U)_U_$P(IBPD,U,2)_U_USER_U_DATE_U_$P(IBPD,U,7)_U_$S($P(IBPD,U,5)="":"<no previous value>",1:$P(IBPD,U,5))_U_$P(IBPD,U,6)
+28 IF IB01=0
Begin DoDot:2
+29 WRITE $PIECE(IBPD,U)_U_USER_U_DATE_U_$PIECE(IBPD,U,7)_U
+30 WRITE $SELECT($PIECE(IBPD,U,5)="":"<no previous value>",1:$PIECE(IBPD,U,5))_U_$PIECE(IBPD,U,6)
End DoDot:2
+31 IF IB01'=0
Begin DoDot:2
+32 WRITE $PIECE(IBPD,U)_U
+33 SET IBPL=""
SET IBPL=$SELECT($PIECE(IBPD,U,8)=36:"INS CO EDITS",1:$PIECE(IBPD,U,2))
+34 if IBPL="NO PLANS SELECTED"
SET IBPL=""
WRITE IBPL_U
+35 WRITE USER_U_DATE_U_$PIECE(IBPD,U,7)_U_$SELECT($PIECE(IBPD,U,5)="":"<no previous value>",1:$PIECE(IBPD,U,5))_U
+36 WRITE $PIECE(IBPD,U,6)
End DoDot:2
+37 WRITE !
+38 ;IB*737/DTG screen check
IF ($Y#($GET(IOSL)-5))=0
SET IBQUIT=0
DO EXLCK
if IBQUIT
QUIT
End DoDot:1
if IBQUIT
QUIT
+39 ;
+40 ;IB*737/DTG quit if screen and exit.
IF IBQUIT
QUIT
+41 ;
+42 ;/vd-IB*2.0*664 - Beginning of new code for Payer data.
+43 IF REPTYP'=1
Begin DoDot:1
+44 ;IB*737/CKB
+45 WRITE !,"Payer^User^Date/Time of Change^Modified Field^Previous Value of Data^Modified Value of Data",!
+46 ;IB*737/CKB - Payer, no data found
+47 IF '$DATA(^TMP("IBPR2",$JOB))
WRITE !,"User Edits do not exist per the selected filters.",!
QUIT
+48 ;IB*737/DTG screen check
FOR IB01=0,1
FOR
SET IB02=$ORDER(^TMP("IBPR2",$JOB,IB01,IB02))
if 'IB02
QUIT
SET IBPD=$GET(^TMP("IBPR2",$JOB,IB01,IB02))
Begin DoDot:2
+49 SET USER=$$GET1^DIQ(200,$PIECE(IBPD,U,2)_",",.01)
+50 SET DATE=$$FMTE^XLFDT($PIECE(IBPD,U,3),2)
+51 WRITE $PIECE(IBPD,U)_U_USER_U_DATE_U_$PIECE(IBPD,U,6)_U_$SELECT($PIECE(IBPD,U,4)="":"<no previous value>",1:$PIECE(IBPD,U,4))_U_$PIECE(IBPD,U,5)
+52 WRITE !
+53 IF ($Y#($GET(IOSL)-5))=0
SET IBQUIT=0
DO EXLCK
if IBQUIT
QUIT
End DoDot:2
if IBQUIT
QUIT
End DoDot:1
+54 ;/vd-IB*2.0*664 - End of new code for Payer data.
+55 ;
+56 ; -- write to screen
+57 ;I $E(IOST,1,2)["C-" W !,"[END OF REPORT]",! S DIR("A")="Press RETURN to continue" D PAUSE
EXEOR ;IB*737/CKB - called if no data was found
+1 WRITE "[END OF REPORT]",!
+2 ;IB*737/DTG include EOR on excel queued check for pause
DO EXLCK
+3 QUIT
+4 ;
EXLCK ; IB*737/DTG new tag for excel to check for pause
+1 ;
+2 IF $EXTRACT(IOST,1,2)["C-"
SET DIR("A")="Press RETURN to continue"
DO PAUSE
WRITE !
+3 QUIT
+4 ;
ENOUT ; IB*737/DTG new TAG to cleanup temp files on exit.
+1 ;
+2 ;clear temp files
+3 KILL ^TMP("IBPYR",$JOB),^TMP("IBINC",$JOB),^TMP("IBUSER",$JOB),^TMP("IBPR",$JOB),^TMP("IBPR2",$JOB),^TMP($JOB)
+4 ; IB*737/DTG to track which DIA(36,"B",INSIENS have been picked up
KILL ^TMP("IBPRINS",$JOB)
+5 QUIT
+6 ;
