IBCNCH3 ;ALB/FA - PATIENT POLICY COMMENT HISTORY ;27-APR-2015
;;2.0;INTEGRATED BILLING;**549**;21-MAR-94;Build 54
;;Per VA Directive 6402, this routine should not be modified.
;
; Patient Policy Comment - Expand the selected Comment
; OR
; Patient Policy Comment - Display Search Comment Results
;
EXPCOM(VMODE) ;EP
; Protocol action to expand a selected Patient Policy Comment
; After selected a comment to expand the IBCNCH POLICY COMMENT EXPAND
; Listman template is shown
; Input: VMODE - 1 if in view only mode, 0 otherwise
; Optional, defaults to 0
; DFN - IEN of the selected Patient
; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
; multiple IEN of the selected Patient Policy
; Output: All Policy Comment History fields displayed
N COMNUM
S:'$D(VMODE) VMODE=0
S VALMBCK="R"
S COMNUM=$$SELCOM^IBCNCH(1,"Select Comment to expand","","IBCNCHIX")
Q:COMNUM=""
D EN(DFN,IBIIEN,COMNUM,VMODE)
Q
;
SEARCH(DFN,IBIIEN,SRCHTXT,FOUNDTXT) ;EP
; Called from SEARCH^IBCNCH2 to display all the comments with the found search
; text in expanded mode with the search text highlighted wherever it was found
; Input: DFN - IEN of the selected Patient
; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
; multiple IEN of the selected Patient Policy
; SRCHTXT - Text user was searching for
; FOUNDTXT- Array of Patient Policy Comment IENS Where the search
; text was found
D EN(DFN,IBIIEN,"","",SRCHTXT,.FOUNDTXT)
Q
;
EN(DFN,IBIIEN,COMIEN,VMODE,SRCHTXT,FOUNDTXT) ; Display the expand Listman template
; Input: DFN - IEN of the selected Patient
; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the multiple IEN
; of the selected Patient Policy
; COMIEN - IEN of the selected Patient Policy Comment
; "" when called to in display search text mode
; VMODE - 1 if in view only mode, 0 otherwise
; Optional, defaults to 0
; SRCHTXT - Text user was searching for
; Optional, only passed when displaying found search text
; FOUNDTXT- Array of Patient Policy Comment IENS Where the search
; text was found
; Optional, only passed when displaying found search text
; Output: COMIEN - COMIEN of comment to display in search mode
; Only set when in search mode
S:'$D(FOUNDTXT) FOUNDTXT=0
K VALMQUIT
I $G(DFN)="" D Q
. W !!,*7,"Patient is not identified."
. D PAUSE^VALM1
I IBIIEN=0 D Q
. W !!,*7,"Patient Policy is not identified."
. D PAUSE^VALM1
;
I FOUNDTXT D Q ; Display Search listman
. S COMIEN=FOUNDTXT(0,1)
. D EN^VALM("IBCNCH POLICY COMMENT SEARCH")
;
I VMODE D Q
. D EN^VALM("IBCNCH POL COMMENT EXPAND VIEW")
D EN^VALM("IBCNCH POLICY COMMENT EXPAND")
I $G(IBFASTXT)'=1 D
. D CLEAN^VALM10,INIT^IBCNCH,HDR^IBCNCH
. S VALMBCK="R"
Q
;
HDR ;EP
; Build the listman template header information
; Input: DFN - IEN of the select Patient
; IBPPOL - ^DPT(DFN,.312,PIEN,0) Where PIEN is the IEN of the
; selected Patient Policy
; COMIEN - IEN of the selected Patient Policy Comment
; "" when called to in display search text mode
; SRCHTXT - Text user was searching for
; Optional, only passed when displaying found search text
; FOUNDTXT- Array of Patient Policy Comments Where the search
; text was found
; Optional, only passed when displaying found search text
N WW,XX,YY,ZZ
S XX=$E($P(^DPT(DFN,0),"^",1),1,20)_" "_$P($$PT^IBEFUNC(DFN),"^",2)
S ZZ=$$GET1^DIQ(2,DFN_",",.03),XX=XX_" "_ZZ
S VALMHDR(1)="Policy Comment History for: "_XX
S ZZ=$G(^DPT(DFN,.312,+$P(IBPPOL,"^",4),0))
S WW=$P($G(^IBA(355.3,+$P(ZZ,"^",18),0)),"^",11)
S YY=$E($P($G(^DIC(36,+ZZ,0)),"^",1),1,20)_" Insurance Company"
S XX="** Plan Currently "_$S(WW:"Ina",1:"A")_"ctive **"
S VALMHDR(2)=$$SETSTR^VALM1(XX,YY,48,29)
I FOUNDTXT D
. S YY=FOUNDTXT(1,COMIEN)
. S XX=$S(YY=1:"1st",YY=2:"2nd",YY=3:"3rd",1:YY_"th")
. S ZZ="Displaying "_XX_" of "_FOUNDTXT_" Pt Policy Comments where '"
. S ZZ=ZZ_SRCHTXT_"' was found."
. S VALMHDR(3)=ZZ
Q
;
INIT ;EP
; Initialize the listman template
; Input: DFN - IEN of the selected Patient
; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
; multiple IEN of the selected Patient Policy
; COMIEN - IEN of the selected Patient Policy Comment
; SRCHTXT - Text user was searching for
; Optional, only passed when displaying found
; search text
; FOUNDTXT - Array of Patient Policy Comment IENS Where
; the search text was found
; Optional, only passed when displaying found
; search text
; Output: ^TMP("IBCNCH3",$J) - Body lines to display for specified template
K ^TMP("IBCNCH3",$J)
S:'$D(SRCHTXT) SRCHTXT=""
D BLD(DFN,IBIIEN,COMIEN,SRCHTXT)
Q
;
BLD(DFN,IBIIEN,COMIEN,SRCHTXT,SMODE) ; Build the listman template body
; Input: DFN - IEN of the select Patient
; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
; multiple IEN of the selected Patient Policy
; COMIEN - IEN of the selected Patient Policy Comment
; SRCHTXT - Text user was searching for or null if not in search
; mode
N ELINEL,ELINER,IENS,SLINE,STARTR
S VALMCNT=0,SLINE=1
S IENS=COMIEN_","_IBIIEN_","_DFN_","
D BLDCOML(IENS,SLINE,.STARTR,.ELINEL,SRCHTXT) ; Build Left Column
;
; The next two lines are in place in case a build right column is ever added.
; If one is added, we would need to determine which side has more lines but
; since none is currently present, temporarily setting ELINER=ELINEL.
S ELINER=ELINEL
S SLINE=$S(ELINEL'>ELINER:ELINER,1:ELINEL)
D BLDCOMT(IENS,SLINE,.ELINEL,SRCHTXT) ; Build Comment Text
S VALMCNT=$O(^TMP("IBCNCH3",$J,""),-1)
Q
;
BLDCOML(IENS,SLINE,STARTR,ELINE,SRCHTXT) ; Build the non-comment section
; of the Expanded Comment Display
; NOTE: Code is set-up to allow a section display to the right of
; this section but none exists at present
; Input: IENS - String of IENS needed to access comment fields
; SLINE - Starting Line Number
; ELINE - Current Ending Line Number
; SRCHTXT - Text user was searching for
; Optional, only passed when displaying found search text
; Output: STARTR - Line to start displaying Right Column
; ELINE - Updated Ending Line
;
N XX
S STARTR=SLINE ; Start of Right Section
S XX=$$GET1^DIQ(2.342,IENS,.01,"I")
S XX=$$FMTE^XLFDT(XX,"2SZ")
S ELINE=$$SET("Last Edited Date: ",XX,SLINE,1)
S ELINE=$$SET(" Last Edited By: ",$$GET1^DIQ(2.342,IENS,.02),ELINE,1)
S ELINE=$$SET(" Contact Person: ",$$GET1^DIQ(2.342,IENS,.04),ELINE,1,SRCHTXT)
S ELINE=$$SET(" Contact Phone #: ",$$GET1^DIQ(2.342,IENS,.05),ELINE,1,SRCHTXT)
S ELINE=$$SET(" Method: ",$$GET1^DIQ(2.342,IENS,.07),ELINE,1,SRCHTXT)
S ELINE=$$SET("Call Reference #: ",$$GET1^DIQ(2.342,IENS,.06),ELINE,1,SRCHTXT)
S ELINE=$$SET(" Authorization #: ",$$GET1^DIQ(2.342,IENS,.08),ELINE,1,SRCHTXT)
Q
;
BLDCOMT(IENS,SLINE,ELINE,SRCHTXT) ; Build the Comment Text Section
; Input: IENS - String of IENS needed to access comment fields
; SLINE - Starting Line Number
; ELINE - Current Ending Line Number
; SRCHTXT - Text user was searching for
; Optional, only passed when displaying found search text
; Output: ELINE - Updated Ending Line Number
;
N COMTEXT,CPOS,REM,XX
S COMTEXT=$$GET1^DIQ(2.342,IENS,.03)
S ELINE=$$SET("","",SLINE,1) ; Spacing Blank Line
S ELINE=$$SET("Comment","",ELINE,1)
S ELINE=$$SETC(COMTEXT,ELINE,SRCHTXT) ; Display comment line(s)
Q
;
SETC(DATA,LINE,SRCHTXT) ; Sets comment text into the body of the worklist
; Input: DATA - Comment Text to set into line(s)
; LINE - Current Line text is being set into
; SRCHTXT - Text user was searching for
; Optional, only passed when displaying found search text
; Returns: LINE - Updated Line text is being set into
;
N CLNEND,CPOS,CWLPOS,CWPOS,CWEPOS,DATAU,SPOS,STLEN,STXTU,XX
S:'$D(SRCHTXT) SRCHTXT=""
S STLEN=$L(SRCHTXT)
S DATAU=$$UP^XLFSTR(DATA)
S STXTU=$$UP^XLFSTR(SRCHTXT)
;
; Display the comment text 1 line at a time and if in search mode displaying
; any instances of found search text in reverse video
S (CPOS,SPOS)=0,CLNEND=80
S (CWLPOS,CWPOS)=1,CWEPOS=$L(DATA)
F D Q:(CWPOS>CWEPOS)
. I SRCHTXT'="" D
. . S CPOS=$F(DATAU,STXTU,CWPOS),SPOS=0
. . Q:'CPOS
. . S SPOS=CPOS-STLEN ; Starting position of found text
. ;
. ; Not in search mode OR search text not found in characters CWPOS-CLNEND
. ; of the comment. Display the text from position CWPOS-CLNEND
. I 'SPOS!(SPOS>CLNEND) D Q
. . S XX=$E(DATA,CWPOS,CLNEND)
. . D SET1(XX,LINE,CWLPOS,$L(XX))
. . S LINE=LINE+1,CWLPOS=1
. . S CWPOS=CLNEND+1,CLNEND=CLNEND+80
. ;
. ; Search text found starting somewhere in current comment line. First
. ; display any text in front of the found search text
. I SPOS>1 D
. . S XX=$E(DATA,CWPOS,SPOS-1),CWPOS=SPOS
. . D SET1(XX,LINE,CWLPOS,$L(XX))
. . S CWLPOS=CWLPOS+$L(XX)
. ;
. ; If entire search text found in characters CWPOS-CLNEND. Display search
. ; text in reverse video
. I (CPOS-1)'>CLNEND D Q
. . S XX=$E(DATA,CWPOS,(CPOS-1)),CWPOS=CPOS
. . D SET1(XX,LINE,CWLPOS,$L(XX),0,1)
. . S CWLPOS=CWLPOS+STLEN
. ;
. ; Search text is straddling comment text lines. First display the start of
. ; the search text on the current line in reverse video
. S XX=$E(DATA,SPOS,CLNEND),CWPOS=CLNEND+1
. D SET1(XX,LINE,CWLPOS,$L(XX),0,1)
. S LINE=LINE+1,CLNEND=CLNEND+80,CWLPOS=1
. ;
. ; Next display remaining search text in reverse video
. S XX=$E(DATA,CWPOS,(CPOS-1)),CWPOS=CPOS
. D SET1(XX,LINE,CWLPOS,$L(XX),0,1)
. S CWLPOS=CWLPOS+$L(XX)
Q LINE
;
SET(LABEL,DATA,LINE,COL,SRCHTXT) ; Sets text into the body of the worklist
; Input: LABEL - Label text to set into the line
; DATA - Field Data to set into the line
; LINE - Line to set LABEL and DATA into
; COL - Starting column position in LINE to insert
; LABEL_DATA text
; SRCHTXT - Text user was searching for
; Optional, only passed when displaying found search text
; Returns: LINE - Updated Line by 1
;
N COL,DATAU,FPOS,START,STXTU,WHICH,XX
S:'$D(SRCHTXT) SRCHTXT=""
S DATAU=$$UP^XLFSTR(DATA)
S STXTU=$$UP^XLFSTR(SRCHTXT)
S WHICH=$S(SRCHTXT="":0,DATAU[STXTU:1,1:0)
D SET1(LABEL,LINE,1,$L(LABEL),1) ; First display the label
;
; Not in search mode OR search text not found
I 'WHICH D Q LINE
. D SET1(DATA,LINE,$L(LABEL)+1,$L(DATA))
. S LINE=LINE+1
;
; Display text with all occurrences of the search text in reverse video
S COL=$L(LABEL)+1
F D Q:(DATA="")!'FPOS
. S FPOS=$F(DATAU,STXTU) ; Find the search text
. Q:'FPOS ; No more occurrences found
. S XX=FPOS-$L(SRCHTXT)-1
. S START=$S(XX:$E(DATA,1,XX),1:"")
. I START'="" D
. . D SET1(START,LINE,COL,$L(START))
. . S COL=COL+$L(START)
. S XX=$E(DATA,XX+1,FPOS-1)
. D SET1(XX,LINE,COL,$L(XX),0,1)
. S COL=COL+$L(SRCHTXT)
. S DATA=$E(DATA,FPOS,$L(DATA))
. S DATAU=$E(DATAU,FPOS,$L(DATAU))
D:DATA'="" SET1(DATA,LINE,COL,$L(DATA)) ; Display any remaining text
S LINE=LINE+1
Q LINE
;
SET1(TEXT,LINE,COL,WIDTH,BOLD,RV) ; Sets the TMP array with body data
; Input: TEXT - Text to be set into the specified line
; LINE - Line to set TEXT into
; COL - Column of LINE to set TEXT into
; WIDTH - Width of the TEXT being set into line
; BOLD - 1 - Set bold on, 0 otherwise
; Optional, defaults to ""
; RV - 1 - Set Reverse Video on, 0 otherwise
; Optional, defaults to ""
; ^TMP("IBCNCH3",$J) - Current ^TMP array
; Output: ^TMP("IBCNCH3",$J) - Updated ^TMP array
;
N IBX
S:'$D(BOLD) BOLD=0
S:'$D(RV) RV=0
S IBX=$G(^TMP("IBCNCH3",$J,LINE,0))
S IBX=$$SETSTR^VALM1(TEXT,IBX,COL,WIDTH)
D SET^VALM10(LINE,IBX)
D:BOLD CNTRL^VALM10(LINE,COL,WIDTH,IOINHI,IOINORM)
D:RV CNTRL^VALM10(LINE,COL,WIDTH,IORVON,IORVOFF)
Q
;
HELP ;EP
; Display the listman template help
N X
S X="?"
D DISP^XQORM1
W !!
Q
;
EXIT ;EP
; Exit the listman template
K ^TMP("IBCNCH3",$J)
D CLEAR^VALM1
Q
;
NEXTCOM ;EP
; Protocol action to show the next comment with the found Search text
; Input: DFN - IEN of the selected Patient
; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
; multiple IEN of the selected Patient Policy
; COMIEN - IEN of the currently displayed Patient Policy Comment
; FOUNDTXT- Array of Patient Policy Comment IENS Where the search
; text was found
; Output: Next Patient Policy Comment is displayed
; COMIEN - IEN of the next Patient Policy Comment to display
N XX
S VALMBCK="R"
S XX=FOUNDTXT(1,COMIEN),XX=$O(FOUNDTXT(0,XX))
I XX="" D Q
. W !!,*7,"No more comments with the search text were found."
. D PAUSE^VALM1
S COMIEN=FOUNDTXT(0,XX)
D CLEAN^VALM10
D HDR,INIT
Q
;
PREVCOM ;EP
; Protocol action to show the previous comment with the found Search text
; Input: DFN - IEN of the selected Patient
; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
; multiple IEN of the selected Patient Policy
; FOUNDTXT- Array of Patient Policy Comment IENS Where the search
; text was found
; Output: Next Patient Policy Comment is displayed
; COMIENS - Updated Index into the FOUNDTXT array of the Patient
; Policy Comment currently being shown
N XX
S VALMBCK="R"
S XX=FOUNDTXT(1,COMIEN),XX=$O(FOUNDTXT(0,XX),-1)
I XX="" D Q
. W !!,*7,"First comment with the search text is already being displayed."
. D PAUSE^VALM1
S COMIEN=FOUNDTXT(0,XX)
D CLEAN^VALM10
D HDR,INIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNCH3 15148 printed Dec 13, 2024@02:14:19 Page 2
IBCNCH3 ;ALB/FA - PATIENT POLICY COMMENT HISTORY ;27-APR-2015
+1 ;;2.0;INTEGRATED BILLING;**549**;21-MAR-94;Build 54
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Patient Policy Comment - Expand the selected Comment
+5 ; OR
+6 ; Patient Policy Comment - Display Search Comment Results
+7 ;
EXPCOM(VMODE) ;EP
+1 ; Protocol action to expand a selected Patient Policy Comment
+2 ; After selected a comment to expand the IBCNCH POLICY COMMENT EXPAND
+3 ; Listman template is shown
+4 ; Input: VMODE - 1 if in view only mode, 0 otherwise
+5 ; Optional, defaults to 0
+6 ; DFN - IEN of the selected Patient
+7 ; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
+8 ; multiple IEN of the selected Patient Policy
+9 ; Output: All Policy Comment History fields displayed
+10 NEW COMNUM
+11 if '$DATA(VMODE)
SET VMODE=0
+12 SET VALMBCK="R"
+13 SET COMNUM=$$SELCOM^IBCNCH(1,"Select Comment to expand","","IBCNCHIX")
+14 if COMNUM=""
QUIT
+15 DO EN(DFN,IBIIEN,COMNUM,VMODE)
+16 QUIT
+17 ;
SEARCH(DFN,IBIIEN,SRCHTXT,FOUNDTXT) ;EP
+1 ; Called from SEARCH^IBCNCH2 to display all the comments with the found search
+2 ; text in expanded mode with the search text highlighted wherever it was found
+3 ; Input: DFN - IEN of the selected Patient
+4 ; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
+5 ; multiple IEN of the selected Patient Policy
+6 ; SRCHTXT - Text user was searching for
+7 ; FOUNDTXT- Array of Patient Policy Comment IENS Where the search
+8 ; text was found
+9 DO EN(DFN,IBIIEN,"","",SRCHTXT,.FOUNDTXT)
+10 QUIT
+11 ;
EN(DFN,IBIIEN,COMIEN,VMODE,SRCHTXT,FOUNDTXT) ; Display the expand Listman template
+1 ; Input: DFN - IEN of the selected Patient
+2 ; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the multiple IEN
+3 ; of the selected Patient Policy
+4 ; COMIEN - IEN of the selected Patient Policy Comment
+5 ; "" when called to in display search text mode
+6 ; VMODE - 1 if in view only mode, 0 otherwise
+7 ; Optional, defaults to 0
+8 ; SRCHTXT - Text user was searching for
+9 ; Optional, only passed when displaying found search text
+10 ; FOUNDTXT- Array of Patient Policy Comment IENS Where the search
+11 ; text was found
+12 ; Optional, only passed when displaying found search text
+13 ; Output: COMIEN - COMIEN of comment to display in search mode
+14 ; Only set when in search mode
+15 if '$DATA(FOUNDTXT)
SET FOUNDTXT=0
+16 KILL VALMQUIT
+17 IF $GET(DFN)=""
Begin DoDot:1
+18 WRITE !!,*7,"Patient is not identified."
+19 DO PAUSE^VALM1
End DoDot:1
QUIT
+20 IF IBIIEN=0
Begin DoDot:1
+21 WRITE !!,*7,"Patient Policy is not identified."
+22 DO PAUSE^VALM1
End DoDot:1
QUIT
+23 ;
+24 ; Display Search listman
IF FOUNDTXT
Begin DoDot:1
+25 SET COMIEN=FOUNDTXT(0,1)
+26 DO EN^VALM("IBCNCH POLICY COMMENT SEARCH")
End DoDot:1
QUIT
+27 ;
+28 IF VMODE
Begin DoDot:1
+29 DO EN^VALM("IBCNCH POL COMMENT EXPAND VIEW")
End DoDot:1
QUIT
+30 DO EN^VALM("IBCNCH POLICY COMMENT EXPAND")
+31 IF $GET(IBFASTXT)'=1
Begin DoDot:1
+32 DO CLEAN^VALM10
DO INIT^IBCNCH
DO HDR^IBCNCH
+33 SET VALMBCK="R"
End DoDot:1
+34 QUIT
+35 ;
HDR ;EP
+1 ; Build the listman template header information
+2 ; Input: DFN - IEN of the select Patient
+3 ; IBPPOL - ^DPT(DFN,.312,PIEN,0) Where PIEN is the IEN of the
+4 ; selected Patient Policy
+5 ; COMIEN - IEN of the selected Patient Policy Comment
+6 ; "" when called to in display search text mode
+7 ; SRCHTXT - Text user was searching for
+8 ; Optional, only passed when displaying found search text
+9 ; FOUNDTXT- Array of Patient Policy Comments Where the search
+10 ; text was found
+11 ; Optional, only passed when displaying found search text
+12 NEW WW,XX,YY,ZZ
+13 SET XX=$EXTRACT($PIECE(^DPT(DFN,0),"^",1),1,20)_" "_$PIECE($$PT^IBEFUNC(DFN),"^",2)
+14 SET ZZ=$$GET1^DIQ(2,DFN_",",.03)
SET XX=XX_" "_ZZ
+15 SET VALMHDR(1)="Policy Comment History for: "_XX
+16 SET ZZ=$GET(^DPT(DFN,.312,+$PIECE(IBPPOL,"^",4),0))
+17 SET WW=$PIECE($GET(^IBA(355.3,+$PIECE(ZZ,"^",18),0)),"^",11)
+18 SET YY=$EXTRACT($PIECE($GET(^DIC(36,+ZZ,0)),"^",1),1,20)_" Insurance Company"
+19 SET XX="** Plan Currently "_$SELECT(WW:"Ina",1:"A")_"ctive **"
+20 SET VALMHDR(2)=$$SETSTR^VALM1(XX,YY,48,29)
+21 IF FOUNDTXT
Begin DoDot:1
+22 SET YY=FOUNDTXT(1,COMIEN)
+23 SET XX=$SELECT(YY=1:"1st",YY=2:"2nd",YY=3:"3rd",1:YY_"th")
+24 SET ZZ="Displaying "_XX_" of "_FOUNDTXT_" Pt Policy Comments where '"
+25 SET ZZ=ZZ_SRCHTXT_"' was found."
+26 SET VALMHDR(3)=ZZ
End DoDot:1
+27 QUIT
+28 ;
INIT ;EP
+1 ; Initialize the listman template
+2 ; Input: DFN - IEN of the selected Patient
+3 ; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
+4 ; multiple IEN of the selected Patient Policy
+5 ; COMIEN - IEN of the selected Patient Policy Comment
+6 ; SRCHTXT - Text user was searching for
+7 ; Optional, only passed when displaying found
+8 ; search text
+9 ; FOUNDTXT - Array of Patient Policy Comment IENS Where
+10 ; the search text was found
+11 ; Optional, only passed when displaying found
+12 ; search text
+13 ; Output: ^TMP("IBCNCH3",$J) - Body lines to display for specified template
+14 KILL ^TMP("IBCNCH3",$JOB)
+15 if '$DATA(SRCHTXT)
SET SRCHTXT=""
+16 DO BLD(DFN,IBIIEN,COMIEN,SRCHTXT)
+17 QUIT
+18 ;
BLD(DFN,IBIIEN,COMIEN,SRCHTXT,SMODE) ; Build the listman template body
+1 ; Input: DFN - IEN of the select Patient
+2 ; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
+3 ; multiple IEN of the selected Patient Policy
+4 ; COMIEN - IEN of the selected Patient Policy Comment
+5 ; SRCHTXT - Text user was searching for or null if not in search
+6 ; mode
+7 NEW ELINEL,ELINER,IENS,SLINE,STARTR
+8 SET VALMCNT=0
SET SLINE=1
+9 SET IENS=COMIEN_","_IBIIEN_","_DFN_","
+10 ; Build Left Column
DO BLDCOML(IENS,SLINE,.STARTR,.ELINEL,SRCHTXT)
+11 ;
+12 ; The next two lines are in place in case a build right column is ever added.
+13 ; If one is added, we would need to determine which side has more lines but
+14 ; since none is currently present, temporarily setting ELINER=ELINEL.
+15 SET ELINER=ELINEL
+16 SET SLINE=$SELECT(ELINEL'>ELINER:ELINER,1:ELINEL)
+17 ; Build Comment Text
DO BLDCOMT(IENS,SLINE,.ELINEL,SRCHTXT)
+18 SET VALMCNT=$ORDER(^TMP("IBCNCH3",$JOB,""),-1)
+19 QUIT
+20 ;
BLDCOML(IENS,SLINE,STARTR,ELINE,SRCHTXT) ; Build the non-comment section
+1 ; of the Expanded Comment Display
+2 ; NOTE: Code is set-up to allow a section display to the right of
+3 ; this section but none exists at present
+4 ; Input: IENS - String of IENS needed to access comment fields
+5 ; SLINE - Starting Line Number
+6 ; ELINE - Current Ending Line Number
+7 ; SRCHTXT - Text user was searching for
+8 ; Optional, only passed when displaying found search text
+9 ; Output: STARTR - Line to start displaying Right Column
+10 ; ELINE - Updated Ending Line
+11 ;
+12 NEW XX
+13 ; Start of Right Section
SET STARTR=SLINE
+14 SET XX=$$GET1^DIQ(2.342,IENS,.01,"I")
+15 SET XX=$$FMTE^XLFDT(XX,"2SZ")
+16 SET ELINE=$$SET("Last Edited Date: ",XX,SLINE,1)
+17 SET ELINE=$$SET(" Last Edited By: ",$$GET1^DIQ(2.342,IENS,.02),ELINE,1)
+18 SET ELINE=$$SET(" Contact Person: ",$$GET1^DIQ(2.342,IENS,.04),ELINE,1,SRCHTXT)
+19 SET ELINE=$$SET(" Contact Phone #: ",$$GET1^DIQ(2.342,IENS,.05),ELINE,1,SRCHTXT)
+20 SET ELINE=$$SET(" Method: ",$$GET1^DIQ(2.342,IENS,.07),ELINE,1,SRCHTXT)
+21 SET ELINE=$$SET("Call Reference #: ",$$GET1^DIQ(2.342,IENS,.06),ELINE,1,SRCHTXT)
+22 SET ELINE=$$SET(" Authorization #: ",$$GET1^DIQ(2.342,IENS,.08),ELINE,1,SRCHTXT)
+23 QUIT
+24 ;
BLDCOMT(IENS,SLINE,ELINE,SRCHTXT) ; Build the Comment Text Section
+1 ; Input: IENS - String of IENS needed to access comment fields
+2 ; SLINE - Starting Line Number
+3 ; ELINE - Current Ending Line Number
+4 ; SRCHTXT - Text user was searching for
+5 ; Optional, only passed when displaying found search text
+6 ; Output: ELINE - Updated Ending Line Number
+7 ;
+8 NEW COMTEXT,CPOS,REM,XX
+9 SET COMTEXT=$$GET1^DIQ(2.342,IENS,.03)
+10 ; Spacing Blank Line
SET ELINE=$$SET("","",SLINE,1)
+11 SET ELINE=$$SET("Comment","",ELINE,1)
+12 ; Display comment line(s)
SET ELINE=$$SETC(COMTEXT,ELINE,SRCHTXT)
+13 QUIT
+14 ;
SETC(DATA,LINE,SRCHTXT) ; Sets comment text into the body of the worklist
+1 ; Input: DATA - Comment Text to set into line(s)
+2 ; LINE - Current Line text is being set into
+3 ; SRCHTXT - Text user was searching for
+4 ; Optional, only passed when displaying found search text
+5 ; Returns: LINE - Updated Line text is being set into
+6 ;
+7 NEW CLNEND,CPOS,CWLPOS,CWPOS,CWEPOS,DATAU,SPOS,STLEN,STXTU,XX
+8 if '$DATA(SRCHTXT)
SET SRCHTXT=""
+9 SET STLEN=$LENGTH(SRCHTXT)
+10 SET DATAU=$$UP^XLFSTR(DATA)
+11 SET STXTU=$$UP^XLFSTR(SRCHTXT)
+12 ;
+13 ; Display the comment text 1 line at a time and if in search mode displaying
+14 ; any instances of found search text in reverse video
+15 SET (CPOS,SPOS)=0
SET CLNEND=80
+16 SET (CWLPOS,CWPOS)=1
SET CWEPOS=$LENGTH(DATA)
+17 FOR
Begin DoDot:1
+18 IF SRCHTXT'=""
Begin DoDot:2
+19 SET CPOS=$FIND(DATAU,STXTU,CWPOS)
SET SPOS=0
+20 if 'CPOS
QUIT
+21 ; Starting position of found text
SET SPOS=CPOS-STLEN
End DoDot:2
+22 ;
+23 ; Not in search mode OR search text not found in characters CWPOS-CLNEND
+24 ; of the comment. Display the text from position CWPOS-CLNEND
+25 IF 'SPOS!(SPOS>CLNEND)
Begin DoDot:2
+26 SET XX=$EXTRACT(DATA,CWPOS,CLNEND)
+27 DO SET1(XX,LINE,CWLPOS,$LENGTH(XX))
+28 SET LINE=LINE+1
SET CWLPOS=1
+29 SET CWPOS=CLNEND+1
SET CLNEND=CLNEND+80
End DoDot:2
QUIT
+30 ;
+31 ; Search text found starting somewhere in current comment line. First
+32 ; display any text in front of the found search text
+33 IF SPOS>1
Begin DoDot:2
+34 SET XX=$EXTRACT(DATA,CWPOS,SPOS-1)
SET CWPOS=SPOS
+35 DO SET1(XX,LINE,CWLPOS,$LENGTH(XX))
+36 SET CWLPOS=CWLPOS+$LENGTH(XX)
End DoDot:2
+37 ;
+38 ; If entire search text found in characters CWPOS-CLNEND. Display search
+39 ; text in reverse video
+40 IF (CPOS-1)'>CLNEND
Begin DoDot:2
+41 SET XX=$EXTRACT(DATA,CWPOS,(CPOS-1))
SET CWPOS=CPOS
+42 DO SET1(XX,LINE,CWLPOS,$LENGTH(XX),0,1)
+43 SET CWLPOS=CWLPOS+STLEN
End DoDot:2
QUIT
+44 ;
+45 ; Search text is straddling comment text lines. First display the start of
+46 ; the search text on the current line in reverse video
+47 SET XX=$EXTRACT(DATA,SPOS,CLNEND)
SET CWPOS=CLNEND+1
+48 DO SET1(XX,LINE,CWLPOS,$LENGTH(XX),0,1)
+49 SET LINE=LINE+1
SET CLNEND=CLNEND+80
SET CWLPOS=1
+50 ;
+51 ; Next display remaining search text in reverse video
+52 SET XX=$EXTRACT(DATA,CWPOS,(CPOS-1))
SET CWPOS=CPOS
+53 DO SET1(XX,LINE,CWLPOS,$LENGTH(XX),0,1)
+54 SET CWLPOS=CWLPOS+$LENGTH(XX)
End DoDot:1
if (CWPOS>CWEPOS)
QUIT
+55 QUIT LINE
+56 ;
SET(LABEL,DATA,LINE,COL,SRCHTXT) ; Sets text into the body of the worklist
+1 ; Input: LABEL - Label text to set into the line
+2 ; DATA - Field Data to set into the line
+3 ; LINE - Line to set LABEL and DATA into
+4 ; COL - Starting column position in LINE to insert
+5 ; LABEL_DATA text
+6 ; SRCHTXT - Text user was searching for
+7 ; Optional, only passed when displaying found search text
+8 ; Returns: LINE - Updated Line by 1
+9 ;
+10 NEW COL,DATAU,FPOS,START,STXTU,WHICH,XX
+11 if '$DATA(SRCHTXT)
SET SRCHTXT=""
+12 SET DATAU=$$UP^XLFSTR(DATA)
+13 SET STXTU=$$UP^XLFSTR(SRCHTXT)
+14 SET WHICH=$SELECT(SRCHTXT="":0,DATAU[STXTU:1,1:0)
+15 ; First display the label
DO SET1(LABEL,LINE,1,$LENGTH(LABEL),1)
+16 ;
+17 ; Not in search mode OR search text not found
+18 IF 'WHICH
Begin DoDot:1
+19 DO SET1(DATA,LINE,$LENGTH(LABEL)+1,$LENGTH(DATA))
+20 SET LINE=LINE+1
End DoDot:1
QUIT LINE
+21 ;
+22 ; Display text with all occurrences of the search text in reverse video
+23 SET COL=$LENGTH(LABEL)+1
+24 FOR
Begin DoDot:1
+25 ; Find the search text
SET FPOS=$FIND(DATAU,STXTU)
+26 ; No more occurrences found
if 'FPOS
QUIT
+27 SET XX=FPOS-$LENGTH(SRCHTXT)-1
+28 SET START=$SELECT(XX:$EXTRACT(DATA,1,XX),1:"")
+29 IF START'=""
Begin DoDot:2
+30 DO SET1(START,LINE,COL,$LENGTH(START))
+31 SET COL=COL+$LENGTH(START)
End DoDot:2
+32 SET XX=$EXTRACT(DATA,XX+1,FPOS-1)
+33 DO SET1(XX,LINE,COL,$LENGTH(XX),0,1)
+34 SET COL=COL+$LENGTH(SRCHTXT)
+35 SET DATA=$EXTRACT(DATA,FPOS,$LENGTH(DATA))
+36 SET DATAU=$EXTRACT(DATAU,FPOS,$LENGTH(DATAU))
End DoDot:1
if (DATA="")!'FPOS
QUIT
+37 ; Display any remaining text
if DATA'=""
DO SET1(DATA,LINE,COL,$LENGTH(DATA))
+38 SET LINE=LINE+1
+39 QUIT LINE
+40 ;
SET1(TEXT,LINE,COL,WIDTH,BOLD,RV) ; Sets the TMP array with body data
+1 ; Input: TEXT - Text to be set into the specified line
+2 ; LINE - Line to set TEXT into
+3 ; COL - Column of LINE to set TEXT into
+4 ; WIDTH - Width of the TEXT being set into line
+5 ; BOLD - 1 - Set bold on, 0 otherwise
+6 ; Optional, defaults to ""
+7 ; RV - 1 - Set Reverse Video on, 0 otherwise
+8 ; Optional, defaults to ""
+9 ; ^TMP("IBCNCH3",$J) - Current ^TMP array
+10 ; Output: ^TMP("IBCNCH3",$J) - Updated ^TMP array
+11 ;
+12 NEW IBX
+13 if '$DATA(BOLD)
SET BOLD=0
+14 if '$DATA(RV)
SET RV=0
+15 SET IBX=$GET(^TMP("IBCNCH3",$JOB,LINE,0))
+16 SET IBX=$$SETSTR^VALM1(TEXT,IBX,COL,WIDTH)
+17 DO SET^VALM10(LINE,IBX)
+18 if BOLD
DO CNTRL^VALM10(LINE,COL,WIDTH,IOINHI,IOINORM)
+19 if RV
DO CNTRL^VALM10(LINE,COL,WIDTH,IORVON,IORVOFF)
+20 QUIT
+21 ;
HELP ;EP
+1 ; Display the listman template help
+2 NEW X
+3 SET X="?"
+4 DO DISP^XQORM1
+5 WRITE !!
+6 QUIT
+7 ;
EXIT ;EP
+1 ; Exit the listman template
+2 KILL ^TMP("IBCNCH3",$JOB)
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
NEXTCOM ;EP
+1 ; Protocol action to show the next comment with the found Search text
+2 ; Input: DFN - IEN of the selected Patient
+3 ; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
+4 ; multiple IEN of the selected Patient Policy
+5 ; COMIEN - IEN of the currently displayed Patient Policy Comment
+6 ; FOUNDTXT- Array of Patient Policy Comment IENS Where the search
+7 ; text was found
+8 ; Output: Next Patient Policy Comment is displayed
+9 ; COMIEN - IEN of the next Patient Policy Comment to display
+10 NEW XX
+11 SET VALMBCK="R"
+12 SET XX=FOUNDTXT(1,COMIEN)
SET XX=$ORDER(FOUNDTXT(0,XX))
+13 IF XX=""
Begin DoDot:1
+14 WRITE !!,*7,"No more comments with the search text were found."
+15 DO PAUSE^VALM1
End DoDot:1
QUIT
+16 SET COMIEN=FOUNDTXT(0,XX)
+17 DO CLEAN^VALM10
+18 DO HDR
DO INIT
+19 QUIT
+20 ;
PREVCOM ;EP
+1 ; Protocol action to show the previous comment with the found Search text
+2 ; Input: DFN - IEN of the selected Patient
+3 ; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
+4 ; multiple IEN of the selected Patient Policy
+5 ; FOUNDTXT- Array of Patient Policy Comment IENS Where the search
+6 ; text was found
+7 ; Output: Next Patient Policy Comment is displayed
+8 ; COMIENS - Updated Index into the FOUNDTXT array of the Patient
+9 ; Policy Comment currently being shown
+10 NEW XX
+11 SET VALMBCK="R"
+12 SET XX=FOUNDTXT(1,COMIEN)
SET XX=$ORDER(FOUNDTXT(0,XX),-1)
+13 IF XX=""
Begin DoDot:1
+14 WRITE !!,*7,"First comment with the search text is already being displayed."
+15 DO PAUSE^VALM1
End DoDot:1
QUIT
+16 SET COMIEN=FOUNDTXT(0,XX)
+17 DO CLEAN^VALM10
+18 DO HDR
DO INIT
+19 QUIT
