IBACCWLPREV ;EDE/TPF - ACC (Automated Community Care) Encounters - Action Item Previous Activity ; 12-SEP-2023
;;2.0;INTEGRATED BILLING;**770**;21-MAR-2024;Build 119
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;D EN^IBACCWLPREV(IBDA,IBIFN)
EN(IBENCIFN,IBIFN) ; -- main entry point for IBACC WL GENERIC VIEWER
D EN^VALM("IBACC WL PREV. ACTIVITY VIEWER")
Q
;
HDR ; -- header code
;
N ENCOUNTER
S VALMHDR(1)="Previous Activity for Bill#/Encounter #: "_$$GET1^DIQ(399,IBIFN_",",.01,"E")_"/"_$$GET1^DIQ(364.9,IBENCIFN_",",.15,"E") ;TPF;IB*2*770v17;EBILL-4734
;
Q
;
;CAN BE CALLED FROM RTN ACCENCCOM^IBJTTC OPTION:IBJ THIRD PARTY JOINT INQUIRY
;OR PREVACT^IBACCWLAI, ACTION ITEM: IBACC WL IBACCCOMMON PREV ACTIVITY
;OR PREVREVIEW^IBACCWLAIVIEW
INIT(IBENCIFN,IBIFN,IBLN) ; -- init variables and list array
;
N ABORT,I,IBIFNIEN,IBTPJI,LINE,RECORDNUM ;SET UP COLUMN ARRAY FOR THIS RTN CODE
;
S $P(LINE,"-",81)=""
S RECORDNUM=0
S IBENCIFN=$G(IBENCIFN)
S IBIFN=$G(IBIFN)
;
;THIS IS CURRENTLY BEING CALLED ONLY BY "IBACC WL ACC CLAIMS WORKLIST" BUT LETS NOT ASSUME IT WILL BE THE ONLY ONE
I ($P($G(XQY0),U)'="IBACC WL ACC CLAIMS WORKLIST"),(IBIFN&$D(IBLN)) N VALMDDF,LISTIEN
I ($P($G(XQY0),U)'="IBACC WL ACC CLAIMS WORKLIST"),(IBIFN&$D(IBLN)) D Q:$G(ABORT)
.S IBTPJI=1
.S LISTIEN=$O(^SD(409.61,"B","IBACC WL PREV. ACTIVITY VIEWER",""))
.I LISTIEN="" W !!,"'IBACC WL PREV. ACTIVITY VIEWER' LIST TEMPLATE CAN NOT BE FOUND!!" S ABORT=1 Q
.S I=0 ;SET UP COLUMN DATA ARRAY
.F S I=$O(^SD(409.61,LISTIEN,"COL",I)) Q:'I I $D(^(I,0)) S VALMDDF($P(^(0),U))=^(0)
E S IBTPJI=0 K @VALMAR
;
;BILL CAN HAVE SEVERAL ENCOUNTERS ASSOCIATED WITH IT.
I $G(IBTPJI) S IBENCIFN=0 D Q
.F S IBENCIFN=$O(^IBA(364.9,"C",IBIFN,IBENCIFN)) Q:IBENCIFN="" D
..D SETIBTPJIHDR(.IBLN,.RECORDNUM,IBENCIFN,IBIFN)
..D ENCOUNTERS(IBENCIFN,IBIFN,.RECORDNUM)
..;
;
I '$G(IBENCIFN) D Q
.W !!,"ENCOUNTER ENTRY IN FILE #364.9 UNDEFINED!!"
.N DIR ;TPF;IB*2*770v47;EBILL-6042
.D PAUSE^VALM1
;
D ENCOUNTERS(IBENCIFN,IBIFN)
;
Q
;
ENCOUNTERS(IBENCIFN,IBIFN,RECORDNUM) ;EP - PULL PREV. ACTIVITY FOR EACH ENCOUNTER
;
N IBBILL,PREVACTLSTDT ;TPF;IB*2*770v18; DISCOVERED BUG
N LINENUM ;TPF XINDEX
;
I IBIFN'="" D
.S DFN=$P($G(^DGCR(399,+$G(IBIFN),0)),U,2)
.S IBBILL=$P($G(^DGCR(399,IBIFN,0)),U)
E D
.W !!,"This encounter does not have a K#."
W:$G(IBBILL)'="" !,"ACC CLAIM/BILL "_$G(IBBILL)_" SELECTED" H 2
;
S VALMCNT=0
I $G(IBLN)'="" S VALMCNT=IBLN
E S VALMCNT=0
S PREVACTLSTDT=$O(^IBA(364.9,IBENCIFN,4,"B",""),-1) ;PREVIOUS ACTIVITY LAST DATE ;IF REVERSE ORDER
;
I PREVACTLSTDT="" D Q
.S RECORDNUM=$G(RECORDNUM)+1
.S RECORD=""
.S RECORD=$$SETFLD^VALM1(RECORDNUM,RECORD,"LINENUM")
.S DATA="NO PREVIOUS ACTIVITY DATA FOUND"
.S RECORD=$$SETFLD^VALM1(DATA,RECORD,"RECORD")
.D SET(RECORD,.VALMCNT,.RECORDNUM,$G(PREVACTIENS),1)
.N DIR,DIRUT,DUOUT,DTOUT
.D PAUSE^VALM1
.S VALMBCK="R"
;
S PREVACTLSTDT=PREVACTLSTDT+.0001
F S PREVACTLSTDT=$O(^IBA(364.9,IBENCIFN,4,"B",PREVACTLSTDT),-1) Q:'PREVACTLSTDT D
.S PREVACTIEN=$O(^IBA(364.9,IBENCIFN,4,"B",PREVACTLSTDT,0))
.S PREVACTIENS=PREVACTIEN_","_IBENCIFN_","
.D GETS^DIQ(364.94,PREVACTIENS,"**","EIR","PREVACTRET","ERROR")
.D CAPTION(364.94,PREVACTIENS,.PREVACTRET,.VALMCNT,.LINENUM,.RECORDNUM,1)
.K PREVACTRET,ERROR
;
I '$D(@VALMAR) W !!,"NO PREVIOUS ACTIVITY DATA FOUND" D
.N DIR,DIRUT,DUOUT,DTOUT
.D PAUSE^VALM1
;
S IBLN=$G(VALMCNT)
S VALMBCK="R"
Q
;
CAPTION(FILENUM,PREVACTIENS,PREVACTRET,VALMCNT,LINENUM,RECORDNUM,SET) ;EP - CATPIONS FOR FIELD DATA
;
N ACTDESC,ACTIEN,CAPTION,CAPOFFSET,RECORD
S CAPOFFSET=20
F FIELDNAME="DATE/TIME ENTERED","ACTIVITY CODE","ENTERED BY","ASSIGNING GROUP","REASSIGNED TO GROUP" D
.;
.S RECORD=""
.;
.I FIELDNAME="DATE/TIME ENTERED" D
..S RECORDNUM=$G(RECORDNUM)+1
..S RECORD=$$SETFLD^VALM1(RECORDNUM,RECORD,"LINENUM")
.;
.I FIELDNAME="ACTIVITY CODE" D Q
..S ACTIEN=$G(PREVACTRET(364.94,PREVACTIENS,FIELDNAME,"I"))
..S:ACTIEN ACTDESC=$P($G(^IBA(364.92,ACTIEN,0)),U,2)
..;
..S CAPTION=$J(FIELDNAME_": ",CAPOFFSET)
..S DATA=$G(PREVACTRET(FILENUM,PREVACTIENS,FIELDNAME,"E"))_" "_$G(ACTDESC)
..S DATA=CAPTION_DATA
..S RECORD=$$SETFLD^VALM1(DATA,RECORD,"RECORD")
..;
..D SET(RECORD,.VALMCNT,.RECORDNUM,PREVACTIENS,SET)
..;
.S CAPTION=$J(FIELDNAME_": ",CAPOFFSET)
.S DATA=$G(PREVACTRET(FILENUM,PREVACTIENS,FIELDNAME,"E"))
.S DATA=CAPTION_DATA
.S RECORD=$$SETFLD^VALM1(DATA,RECORD,"RECORD")
.D SET(RECORD,.VALMCNT,.RECORDNUM,PREVACTIENS,SET)
;
D COMMENTS(.PREVACTRET,.VALMCNT,.RECORDNUM,SET)
;
S RECORD=""
D SET(RECORD,.VALMCNT,.RECORDNUM,PREVACTIENS,SET)
;
Q
;
CAPITALIZE(COLHEADER) ;EP - CONVERT COLUMNS FROM UPPERCASE
;
N PIECE,NEWSTR,OLDSTR
;ASSUME FIELD NAMES MAY BE DELIMITED BY SPACES OR /
S NEWSTR=""
F PIECE=1:1 S OLDSTR=$P(COLHEADER," ",PIECE) Q:OLDSTR="" D
.S NEWSTR=NEWSTR_$$SENTENCE^XLFSTR(OLDSTR)
S COLHEADER=NEWSTR
;
Q
;
N CHAR,COMMENT,COMMENTS,COMNUM,LINE,NEXTLINE,PREVCOMIEN,WINDOW
S NEXTLINE=""
S PREVCOMIEN=0
N CAPOFFSET ;TPF;IB*2*770v51;EBILL-6174
S CAPOFFSET=0 ;TPF;IB*2*770v51;EBILL-6174
;
F COMNUM=1:1 S PREVCOMIEN=$O(PRECOMARRAY(FILENUM,PREVACTIENS,"PREVIOUS ACTIVITY COMMENTS",PREVCOMIEN)) Q:'PREVCOMIEN D
.;
.S COMMENT=""
.I COMNUM=1 D
..;
..S COMMENT=$$SETFLD^VALM1($J("COMMENTS:",CAPOFFSET),COMMENT,"RECORD")
..D SET(COMMENT,.VALMCNT,RECORDNUM,PREVACTIENS,SET)
.;
.S LINE=$G(PRECOMARRAY(FILENUM,PREVACTIENS,"PREVIOUS ACTIVITY COMMENTS",PREVCOMIEN))
.;
.I $L(LINE)>81 D WORDWRAP(LINE,20) ;TPF;IB*2*770v51;EBILL-6174
.;BEGIN TPF;IB*2*770v51;EBILL-6174
.;I COMNUM'=1 S LINE=NEXTLINE_" "_LINE
.;S WINDOW=80-CAPOFFSET
.;S CHAR=1
.;I $L(LINE)>WINDOW D ;LINE > WINDOW SIZE
.;.S CHAR=0
.;.I $E(LINE,WINDOW+CHAR)'=" " D
.;..F CHAR=1:1 Q:$E(LINE,WINDOW-CHAR)=" "!((WINDOW-CHAR)=0) ;FIND A SPACE TO CHOP THE LINE
.;.S NEXTLINE=$E(LINE,WINDOW-CHAR+1,80)
.;.S LINE=$E(LINE,1,WINDOW-2)
.;END TPF;IB*2*770v51;EBILL-6174
.;
.S COMMENT=""
.S COMMENT=$$SETFLD^VALM1($J("",CAPOFFSET)_LINE,COMMENT,"RECORD")
.D SET(COMMENT,.VALMCNT,RECORDNUM,PREVACTIENS,SET)
.S LINE=""
.;
Q
;
SETIBTPJIHDR(IBLN,RECORDNUM,IBENCIFN,IBIFN) ;EP - SET TPJIJ COMMENT HEADER FOR ACC ENCOUNTER PREVIOUS ACTIVITY
;
N IBBILL,IBENC
;
S VALMCNT=IBLN
;
S:$G(IBIFN) IBBILL=$P($G(^DGCR(399,IBIFN,0)),U)
S:$G(IBENCIFN) IBENC=$$GET1^DIQ(364.9,IBENCIFN_",",.01)
;
S (DATA,RECORD)=""
S DATA=$$SETSTR^VALM1("ACC ENCOUNTER COMMENTS FOR",DATA,25,54)
S RECORD=$$SETFLD^VALM1(DATA,RECORD,"RECORD")
D SET(RECORD,.VALMCNT,.RECORDNUM,"",1)
;
S (DATA,RECORD)=""
S DATA=$$SETSTR^VALM1("BILL: "_$G(IBBILL),DATA,25,54)
S RECORD=$$SETFLD^VALM1(DATA,RECORD,"RECORD")
D SET(RECORD,.VALMCNT,.RECORDNUM,"",1)
;
S (DATA,RECORD)=""
S DATA=$$SETSTR^VALM1("ENCOUNTER DATE: "_$G(IBENC),DATA,25,54)
S RECORD=$$SETFLD^VALM1(DATA,RECORD,"RECORD")
D SET(RECORD,.VALMCNT,.RECORDNUM,"",1)
;
S (DATA,RECORD)=""
S DATA=$$SETSTR^VALM1(LINE,DATA,1,80)
S RECORD=$$SETFLD^VALM1(DATA,RECORD,"RECORD")
D SET(RECORD,.VALMCNT,.RECORDNUM,"",1)
S IBLN=VALMCNT
;
Q
;
SET(X,VALMCNT,RECORDNUM,IEN,SET) ;EP -
;
I '$G(SET) D Q
.W !,X
;
S VALMCNT=VALMCNT+1
S @VALMAR@(VALMCNT,0)=X
S @VALMAR@("IDX",VALMCNT,RECORDNUM)=""
S:$G(IEN)'="" @VALMAR@(VALMCNT)=$G(IEN)
;
Q
;
HELP ; -- help code
;
D PROTOCOL^IBACCWLUTIL
;
Q
;
EXIT ; -- exit code
K @VALMAR
Q
;
EXPND ; -- expand code
Q
;
;IF LINE >80 THE USE WP UTILITY
;D WORDWRAP^IBACCWLPREV(" At least one Rendering Provider's Specialty Code of 99 is invalid for Medicare ")
;NEW TPF;IB*2*770v51;EBILL-6174
WORDWRAP(LINE,INDENT) ;EP - TAKE LONG LINE AND APPLY WORD PROCESSOR TO IT
N COMMENT,DIWL,DIWPIEN,DIWR,DIWF,OFFSET
K ^UTILITY($J,"W")
S DIWL=1,DIWR=80,DIWF="" ;ACCUMULATE MODE
S $P(OFFSET," ",INDENT)=""
S X=LINE
D ^DIWP ;OUR OWN LITTLE VISTA WORD PROCESSOR
S WPIEN=$O(^UTILITY($J,"W",""))
S DIWPIEN=0
F S DIWPIEN=$O(^UTILITY($J,"W",WPIEN,DIWPIEN)) Q:DIWPIEN="" D
.S COMMENT=$G(^UTILITY($J,"W",WPIEN,DIWPIEN,0))
.I DIWPIEN=1 W !,COMMENT
.E W !,OFFSET_COMMENT
K ^UTILITY($J,"W")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACCWLPREV 8400 printed May 25, 2026@12:10:02 Page 2
IBACCWLPREV ;EDE/TPF - ACC (Automated Community Care) Encounters - Action Item Previous Activity ; 12-SEP-2023
+1 ;;2.0;INTEGRATED BILLING;**770**;21-MAR-2024;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;D EN^IBACCWLPREV(IBDA,IBIFN)
EN(IBENCIFN,IBIFN) ; -- main entry point for IBACC WL GENERIC VIEWER
+1 DO EN^VALM("IBACC WL PREV. ACTIVITY VIEWER")
+2 QUIT
+3 ;
HDR ; -- header code
+1 ;
+2 NEW ENCOUNTER
+3 ;TPF;IB*2*770v17;EBILL-4734
SET VALMHDR(1)="Previous Activity for Bill#/Encounter #: "_$$GET1^DIQ(399,IBIFN_",",.01,"E")_"/"_$$GET1^DIQ(364.9,IBENCIFN_",",.15,"E")
+4 ;
+5 QUIT
+6 ;
+7 ;CAN BE CALLED FROM RTN ACCENCCOM^IBJTTC OPTION:IBJ THIRD PARTY JOINT INQUIRY
+8 ;OR PREVACT^IBACCWLAI, ACTION ITEM: IBACC WL IBACCCOMMON PREV ACTIVITY
+9 ;OR PREVREVIEW^IBACCWLAIVIEW
INIT(IBENCIFN,IBIFN,IBLN) ; -- init variables and list array
+1 ;
+2 ;SET UP COLUMN ARRAY FOR THIS RTN CODE
NEW ABORT,I,IBIFNIEN,IBTPJI,LINE,RECORDNUM
+3 ;
+4 SET $PIECE(LINE,"-",81)=""
+5 SET RECORDNUM=0
+6 SET IBENCIFN=$GET(IBENCIFN)
+7 SET IBIFN=$GET(IBIFN)
+8 ;
+9 ;THIS IS CURRENTLY BEING CALLED ONLY BY "IBACC WL ACC CLAIMS WORKLIST" BUT LETS NOT ASSUME IT WILL BE THE ONLY ONE
+10 IF ($PIECE($GET(XQY0),U)'="IBACC WL ACC CLAIMS WORKLIST")
IF (IBIFN&$DATA(IBLN))
NEW VALMDDF,LISTIEN
+11 IF ($PIECE($GET(XQY0),U)'="IBACC WL ACC CLAIMS WORKLIST")
IF (IBIFN&$DATA(IBLN))
Begin DoDot:1
+12 SET IBTPJI=1
+13 SET LISTIEN=$ORDER(^SD(409.61,"B","IBACC WL PREV. ACTIVITY VIEWER",""))
+14 IF LISTIEN=""
WRITE !!,"'IBACC WL PREV. ACTIVITY VIEWER' LIST TEMPLATE CAN NOT BE FOUND!!"
SET ABORT=1
QUIT
+15 ;SET UP COLUMN DATA ARRAY
SET I=0
+16 FOR
SET I=$ORDER(^SD(409.61,LISTIEN,"COL",I))
if 'I
QUIT
IF $DATA(^(I,0))
SET VALMDDF($PIECE(^(0),U))=^(0)
End DoDot:1
if $GET(ABORT)
QUIT
+17 IF '$TEST
SET IBTPJI=0
KILL @VALMAR
+18 ;
+19 ;BILL CAN HAVE SEVERAL ENCOUNTERS ASSOCIATED WITH IT.
+20 IF $GET(IBTPJI)
SET IBENCIFN=0
Begin DoDot:1
+21 FOR
SET IBENCIFN=$ORDER(^IBA(364.9,"C",IBIFN,IBENCIFN))
if IBENCIFN=""
QUIT
Begin DoDot:2
+22 DO SETIBTPJIHDR(.IBLN,.RECORDNUM,IBENCIFN,IBIFN)
+23 DO ENCOUNTERS(IBENCIFN,IBIFN,.RECORDNUM)
+24 ;
End DoDot:2
End DoDot:1
QUIT
+25 ;
+26 IF '$GET(IBENCIFN)
Begin DoDot:1
+27 WRITE !!,"ENCOUNTER ENTRY IN FILE #364.9 UNDEFINED!!"
+28 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+29 DO PAUSE^VALM1
End DoDot:1
QUIT
+30 ;
+31 DO ENCOUNTERS(IBENCIFN,IBIFN)
+32 ;
+33 QUIT
+34 ;
ENCOUNTERS(IBENCIFN,IBIFN,RECORDNUM) ;EP - PULL PREV. ACTIVITY FOR EACH ENCOUNTER
+1 ;
+2 ;TPF;IB*2*770v18; DISCOVERED BUG
NEW IBBILL,PREVACTLSTDT
+3 ;TPF XINDEX
NEW LINENUM
+4 ;
+5 IF IBIFN'=""
Begin DoDot:1
+6 SET DFN=$PIECE($GET(^DGCR(399,+$GET(IBIFN),0)),U,2)
+7 SET IBBILL=$PIECE($GET(^DGCR(399,IBIFN,0)),U)
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 WRITE !!,"This encounter does not have a K#."
End DoDot:1
+10 if $GET(IBBILL)'=""
WRITE !,"ACC CLAIM/BILL "_$GET(IBBILL)_" SELECTED"
HANG 2
+11 ;
+12 SET VALMCNT=0
+13 IF $GET(IBLN)'=""
SET VALMCNT=IBLN
+14 IF '$TEST
SET VALMCNT=0
+15 ;PREVIOUS ACTIVITY LAST DATE ;IF REVERSE ORDER
SET PREVACTLSTDT=$ORDER(^IBA(364.9,IBENCIFN,4,"B",""),-1)
+16 ;
+17 IF PREVACTLSTDT=""
Begin DoDot:1
+18 SET RECORDNUM=$GET(RECORDNUM)+1
+19 SET RECORD=""
+20 SET RECORD=$$SETFLD^VALM1(RECORDNUM,RECORD,"LINENUM")
+21 SET DATA="NO PREVIOUS ACTIVITY DATA FOUND"
+22 SET RECORD=$$SETFLD^VALM1(DATA,RECORD,"RECORD")
+23 DO SET(RECORD,.VALMCNT,.RECORDNUM,$GET(PREVACTIENS),1)
+24 NEW DIR,DIRUT,DUOUT,DTOUT
+25 DO PAUSE^VALM1
+26 SET VALMBCK="R"
End DoDot:1
QUIT
+27 ;
+28 SET PREVACTLSTDT=PREVACTLSTDT+.0001
+29 FOR
SET PREVACTLSTDT=$ORDER(^IBA(364.9,IBENCIFN,4,"B",PREVACTLSTDT),-1)
if 'PREVACTLSTDT
QUIT
Begin DoDot:1
+30 SET PREVACTIEN=$ORDER(^IBA(364.9,IBENCIFN,4,"B",PREVACTLSTDT,0))
+31 SET PREVACTIENS=PREVACTIEN_","_IBENCIFN_","
+32 DO GETS^DIQ(364.94,PREVACTIENS,"**","EIR","PREVACTRET","ERROR")
+33 DO CAPTION(364.94,PREVACTIENS,.PREVACTRET,.VALMCNT,.LINENUM,.RECORDNUM,1)
+34 KILL PREVACTRET,ERROR
End DoDot:1
+35 ;
+36 IF '$DATA(@VALMAR)
WRITE !!,"NO PREVIOUS ACTIVITY DATA FOUND"
Begin DoDot:1
+37 NEW DIR,DIRUT,DUOUT,DTOUT
+38 DO PAUSE^VALM1
End DoDot:1
+39 ;
+40 SET IBLN=$GET(VALMCNT)
+41 SET VALMBCK="R"
+42 QUIT
+43 ;
CAPTION(FILENUM,PREVACTIENS,PREVACTRET,VALMCNT,LINENUM,RECORDNUM,SET) ;EP - CATPIONS FOR FIELD DATA
+1 ;
+2 NEW ACTDESC,ACTIEN,CAPTION,CAPOFFSET,RECORD
+3 SET CAPOFFSET=20
+4 FOR FIELDNAME="DATE/TIME ENTERED","ACTIVITY CODE","ENTERED BY","ASSIGNING GROUP","REASSIGNED TO GROUP"
Begin DoDot:1
+5 ;
+6 SET RECORD=""
+7 ;
+8 IF FIELDNAME="DATE/TIME ENTERED"
Begin DoDot:2
+9 SET RECORDNUM=$GET(RECORDNUM)+1
+10 SET RECORD=$$SETFLD^VALM1(RECORDNUM,RECORD,"LINENUM")
End DoDot:2
+11 ;
+12 IF FIELDNAME="ACTIVITY CODE"
Begin DoDot:2
+13 SET ACTIEN=$GET(PREVACTRET(364.94,PREVACTIENS,FIELDNAME,"I"))
+14 if ACTIEN
SET ACTDESC=$PIECE($GET(^IBA(364.92,ACTIEN,0)),U,2)
+15 ;
+16 SET CAPTION=$JUSTIFY(FIELDNAME_": ",CAPOFFSET)
+17 SET DATA=$GET(PREVACTRET(FILENUM,PREVACTIENS,FIELDNAME,"E"))_" "_$GET(ACTDESC)
+18 SET DATA=CAPTION_DATA
+19 SET RECORD=$$SETFLD^VALM1(DATA,RECORD,"RECORD")
+20 ;
+21 DO SET(RECORD,.VALMCNT,.RECORDNUM,PREVACTIENS,SET)
+22 ;
End DoDot:2
QUIT
+23 SET CAPTION=$JUSTIFY(FIELDNAME_": ",CAPOFFSET)
+24 SET DATA=$GET(PREVACTRET(FILENUM,PREVACTIENS,FIELDNAME,"E"))
+25 SET DATA=CAPTION_DATA
+26 SET RECORD=$$SETFLD^VALM1(DATA,RECORD,"RECORD")
+27 DO SET(RECORD,.VALMCNT,.RECORDNUM,PREVACTIENS,SET)
End DoDot:1
+28 ;
+29 DO COMMENTS(.PREVACTRET,.VALMCNT,.RECORDNUM,SET)
+30 ;
+31 SET RECORD=""
+32 DO SET(RECORD,.VALMCNT,.RECORDNUM,PREVACTIENS,SET)
+33 ;
+34 QUIT
+35 ;
CAPITALIZE(COLHEADER) ;EP - CONVERT COLUMNS FROM UPPERCASE
+1 ;
+2 NEW PIECE,NEWSTR,OLDSTR
+3 ;ASSUME FIELD NAMES MAY BE DELIMITED BY SPACES OR /
+4 SET NEWSTR=""
+5 FOR PIECE=1:1
SET OLDSTR=$PIECE(COLHEADER," ",PIECE)
if OLDSTR=""
QUIT
Begin DoDot:1
+6 SET NEWSTR=NEWSTR_$$SENTENCE^XLFSTR(OLDSTR)
End DoDot:1
+7 SET COLHEADER=NEWSTR
+8 ;
+9 QUIT
+10 ;
+1 NEW CHAR,COMMENT,COMMENTS,COMNUM,LINE,NEXTLINE,PREVCOMIEN,WINDOW
+2 SET NEXTLINE=""
+3 SET PREVCOMIEN=0
+4 ;TPF;IB*2*770v51;EBILL-6174
NEW CAPOFFSET
+5 ;TPF;IB*2*770v51;EBILL-6174
SET CAPOFFSET=0
+6 ;
+7 FOR COMNUM=1:1
SET PREVCOMIEN=$ORDER(PRECOMARRAY(FILENUM,PREVACTIENS,"PREVIOUS ACTIVITY COMMENTS",PREVCOMIEN))
if 'PREVCOMIEN
QUIT
Begin DoDot:1
+8 ;
+9 SET COMMENT=""
+10 IF COMNUM=1
Begin DoDot:2
+11 ;
+12 SET COMMENT=$$SETFLD^VALM1($JUSTIFY("COMMENTS:",CAPOFFSET),COMMENT,"RECORD")
+13 DO SET(COMMENT,.VALMCNT,RECORDNUM,PREVACTIENS,SET)
End DoDot:2
+14 ;
+15 SET LINE=$GET(PRECOMARRAY(FILENUM,PREVACTIENS,"PREVIOUS ACTIVITY COMMENTS",PREVCOMIEN))
+16 ;
+17 ;TPF;IB*2*770v51;EBILL-6174
IF $LENGTH(LINE)>81
DO WORDWRAP(LINE,20)
+18 ;BEGIN TPF;IB*2*770v51;EBILL-6174
+19 ;I COMNUM'=1 S LINE=NEXTLINE_" "_LINE
+20 ;S WINDOW=80-CAPOFFSET
+21 ;S CHAR=1
+22 ;I $L(LINE)>WINDOW D ;LINE > WINDOW SIZE
+23 ;.S CHAR=0
+24 ;.I $E(LINE,WINDOW+CHAR)'=" " D
+25 ;..F CHAR=1:1 Q:$E(LINE,WINDOW-CHAR)=" "!((WINDOW-CHAR)=0) ;FIND A SPACE TO CHOP THE LINE
+26 ;.S NEXTLINE=$E(LINE,WINDOW-CHAR+1,80)
+27 ;.S LINE=$E(LINE,1,WINDOW-2)
+28 ;END TPF;IB*2*770v51;EBILL-6174
+29 ;
+30 SET COMMENT=""
+31 SET COMMENT=$$SETFLD^VALM1($JUSTIFY("",CAPOFFSET)_LINE,COMMENT,"RECORD")
+32 DO SET(COMMENT,.VALMCNT,RECORDNUM,PREVACTIENS,SET)
+33 SET LINE=""
+34 ;
End DoDot:1
+35 QUIT
+36 ;
SETIBTPJIHDR(IBLN,RECORDNUM,IBENCIFN,IBIFN) ;EP - SET TPJIJ COMMENT HEADER FOR ACC ENCOUNTER PREVIOUS ACTIVITY
+1 ;
+2 NEW IBBILL,IBENC
+3 ;
+4 SET VALMCNT=IBLN
+5 ;
+6 if $GET(IBIFN)
SET IBBILL=$PIECE($GET(^DGCR(399,IBIFN,0)),U)
+7 if $GET(IBENCIFN)
SET IBENC=$$GET1^DIQ(364.9,IBENCIFN_",",.01)
+8 ;
+9 SET (DATA,RECORD)=""
+10 SET DATA=$$SETSTR^VALM1("ACC ENCOUNTER COMMENTS FOR",DATA,25,54)
+11 SET RECORD=$$SETFLD^VALM1(DATA,RECORD,"RECORD")
+12 DO SET(RECORD,.VALMCNT,.RECORDNUM,"",1)
+13 ;
+14 SET (DATA,RECORD)=""
+15 SET DATA=$$SETSTR^VALM1("BILL: "_$GET(IBBILL),DATA,25,54)
+16 SET RECORD=$$SETFLD^VALM1(DATA,RECORD,"RECORD")
+17 DO SET(RECORD,.VALMCNT,.RECORDNUM,"",1)
+18 ;
+19 SET (DATA,RECORD)=""
+20 SET DATA=$$SETSTR^VALM1("ENCOUNTER DATE: "_$GET(IBENC),DATA,25,54)
+21 SET RECORD=$$SETFLD^VALM1(DATA,RECORD,"RECORD")
+22 DO SET(RECORD,.VALMCNT,.RECORDNUM,"",1)
+23 ;
+24 SET (DATA,RECORD)=""
+25 SET DATA=$$SETSTR^VALM1(LINE,DATA,1,80)
+26 SET RECORD=$$SETFLD^VALM1(DATA,RECORD,"RECORD")
+27 DO SET(RECORD,.VALMCNT,.RECORDNUM,"",1)
+28 SET IBLN=VALMCNT
+29 ;
+30 QUIT
+31 ;
SET(X,VALMCNT,RECORDNUM,IEN,SET) ;EP -
+1 ;
+2 IF '$GET(SET)
Begin DoDot:1
+3 WRITE !,X
End DoDot:1
QUIT
+4 ;
+5 SET VALMCNT=VALMCNT+1
+6 SET @VALMAR@(VALMCNT,0)=X
+7 SET @VALMAR@("IDX",VALMCNT,RECORDNUM)=""
+8 if $GET(IEN)'=""
SET @VALMAR@(VALMCNT)=$GET(IEN)
+9 ;
+10 QUIT
+11 ;
HELP ; -- help code
+1 ;
+2 DO PROTOCOL^IBACCWLUTIL
+3 ;
+4 QUIT
+5 ;
EXIT ; -- exit code
+1 KILL @VALMAR
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
+3 ;IF LINE >80 THE USE WP UTILITY
+4 ;D WORDWRAP^IBACCWLPREV(" At least one Rendering Provider's Specialty Code of 99 is invalid for Medicare ")
+5 ;NEW TPF;IB*2*770v51;EBILL-6174
WORDWRAP(LINE,INDENT) ;EP - TAKE LONG LINE AND APPLY WORD PROCESSOR TO IT
+1 NEW COMMENT,DIWL,DIWPIEN,DIWR,DIWF,OFFSET
+2 KILL ^UTILITY($JOB,"W")
+3 ;ACCUMULATE MODE
SET DIWL=1
SET DIWR=80
SET DIWF=""
+4 SET $PIECE(OFFSET," ",INDENT)=""
+5 SET X=LINE
+6 ;OUR OWN LITTLE VISTA WORD PROCESSOR
DO ^DIWP
+7 SET WPIEN=$ORDER(^UTILITY($JOB,"W",""))
+8 SET DIWPIEN=0
+9 FOR
SET DIWPIEN=$ORDER(^UTILITY($JOB,"W",WPIEN,DIWPIEN))
if DIWPIEN=""
QUIT
Begin DoDot:1
+10 SET COMMENT=$GET(^UTILITY($JOB,"W",WPIEN,DIWPIEN,0))
+11 IF DIWPIEN=1
WRITE !,COMMENT
+12 IF '$TEST
WRITE !,OFFSET_COMMENT
End DoDot:1
+13 KILL ^UTILITY($JOB,"W")
+14 QUIT
