IBCNCH2 ;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 Comments - 1. Build main insurance comment display
; 2. Search Comments for a specified String
;
BLD(DFN,IBIIEN) ;EP
; Build the listman template body of the main Insurance Comment display
; Input: DFN - IEN of the patient
; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
; multiple IEN of the selected patient policy
; ^TMP($J,"IBCNCHIX",CNT) - See GETCOMS
N CNT,LINE,LN,XX
D GETCOMS(DFN,IBIIEN)
S VALMCNT=0,LINE="",CNT=""
;
F D Q:CNT=""
. S CNT=$O(^TMP($J,"IBCNCHIX",CNT))
. Q:CNT=""
. I CNT'=1 D
. . S VALMCNT=VALMCNT+1
. . D SET^VALM10(VALMCNT,"",VALMCNT)
. ;
. S VALMCNT=VALMCNT+1
. D BLDONEC(.VALMCNT,CNT)
;
I VALMCNT=0 D
. S VALMCNT=1,XX=" *** No comments to display ***"
. D SET^VALM10(VALMCNT,XX,VALMCNT)
Q
;
BLDONEC(VALMCNT,COMCNT) ; (Re)Build one comment into the listman display
; Called from BLD and after adding or editing a comment
; Input: VALMCNT - Current Line of the display being
; (re)built
; COMCNT - Comment Number
; ^TMP($J,"IBCNCHIX",COMCNT) - See GETONEC for details
; Output: VALMCNT - Updated Line of the display being
; (re)built
N DATALN,LINE
S LINE=$$SETL("",COMCNT,"",1,4) ; Comment #
S DATALN=^TMP($J,"IBCNCHIX",COMCNT)
S XX=$P(DATALN,"^",1) ; Dt Entered
S LINE=$$SETL(LINE,XX,"",6,15)
D SET^VALM10(VALMCNT,LINE,VALMCNT)
S XX=$P(DATALN,"^",2) ; Entered By
S LINE=$$SETL(LINE,XX,"",18,37)
D SET^VALM10(VALMCNT,LINE,VALMCNT)
S XX=$P(DATALN,"^",4) ; Method
S LINE=$$SETL(LINE,XX,"",44,52)
D SET^VALM10(VALMCNT,LINE,VALMCNT)
S XX=$P(DATALN,"^",3) ; Person Contacted
S LINE=$$SETL(LINE,XX,"",55,80)
D SET^VALM10(VALMCNT,LINE,VALMCNT)
S VALMCNT=VALMCNT+1
S XX=$E($P(DATALN,"^",8),1,132) ; Start of Comment
S LINE=$$SETL("",XX,"",6,80)
D SET^VALM10(VALMCNT,LINE,VALMCNT)
Q
;
GETCOMS(DFN,IBIIEN) ; Retrieves the policy comments for the selected
; patient and policy in most recent date order
; Input: DFN - IEN of the patient
; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
; multiple IEN of the selected patient policy
; Output: ^TMP($J,"IBCNCHIX",CNT) - A1^A2^A3^A4^A5^A6^A7^A8^A9^A10
; See GETONEC for detailed explanation
N CNT,COMDT,COMIEN
S CNT=0,COMDT=""
F D Q:COMDT=""
. S COMDT=$O(^DPT(DFN,.312,IBIIEN,13,"B",COMDT),-1)
. Q:COMDT=""
. S COMIEN=""
. F D Q:COMIEN=""
. . S COMIEN=$O(^DPT(DFN,.312,IBIIEN,13,"B",COMDT,COMIEN),-1)
. . Q:COMIEN=""
. . S CNT=CNT+1
. . D GETONEC(DFN,IBIIEN,COMIEN,CNT) ; Get One Comment
Q
;
GETONEC(DFN,IBIIEN,COMIEN,CNT,CLEN,FULL,NOSET) ;EP
; Get the Data for a specified Policy Comment
; Input: DFN - IEN of the patient
; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
; multiple IEN of the selected patient policy
; COMIEN - ^DPT(DFN,.312,IBIIEN,13,COMIEN,0) Where
; COMIEN is the multiple IEN of the selected
; Patient Policy Comment
; CNT - Current Comment Selection Number
; CLEN - Length of Partial Comment to be displayed
; Optional, defaults to 74
; FULL - 1 to return the full comment text,
; otherwise
; Optional - defaults to 0
; NOSET - 1 to not set into ^TMP, 0 otherwise
; Optional, defaults to 0
; Output: NOTE: ^TMP($J,"IBCNCHIX",CNT) only set if NOSET=0
; ^TMP($J,"IBCNCHIX",CNT) - A1^A2^A3^A4^A5^A6^A7^A8^A9^A10
; Where:
; CNT - Comment selection # (comments ordered by
; (date entered)
; A1 - External date/time the comment was entered
; NOTE: has a leading '+' when A8 > CLEN
; A2 - External User Name of the user who entered
; the comment
; A3 - Person Contacted
; A4 - Method of Contact
; A5 - Contact Phone #
; A6 - Call Reference #
; A7 - Authorization #
; A8 - Comment
; A9 - Patient Policy Comment IEN
; A10 - Comment Selection Number
N COMMENT,DATAOUT,IENS,XX,ZZ
S:'$D(FULL) FULL=0
S:'$D(NOSET) NOSET=0
S:'$D(CLEN) CLEN=74
S IENS=COMIEN_","_IBIIEN_","_DFN_","
S COMMENT=$$GET1^DIQ(2.342,IENS,.03) ; Comment Text
S XX=$$GET1^DIQ(2.342,IENS,.01,"I") ; Internal Date/Time entered
S ZZ=$S($L(COMMENT)>CLEN:"+",1:" ") ; Truncated Comment Indicator
S DATAOUT=ZZ_$$FMTE^XLFDT($P(XX,"^",1),"2DZ")
S XX=$$GET1^DIQ(2.342,IENS,.02,"I") ; IEN of Last Edited By User
S ZZ=$$GET1^DIQ(200,XX,.01) ; Entered by user
S $P(DATAOUT,"^",2)=$E(ZZ,1,24)
S $P(DATAOUT,"^",3)=$$GET1^DIQ(2.342,IENS,.04) ; Person Contacted
S ZZ=$$GET1^DIQ(2.342,IENS,.07)
S $P(DATAOUT,"^",4)=$E(ZZ,1,10) ; Method of Contact
S $P(DATAOUT,"^",5)=$$GET1^DIQ(2.342,IENS,.05) ; Contact Phone #
S $P(DATAOUT,"^",6)=$$GET1^DIQ(2.342,IENS,.06) ; Call Reference #
S $P(DATAOUT,"^",7)=$$GET1^DIQ(2.342,IENS,.08) ; Authorization #
S ZZ=$S('FULL:$E(COMMENT,1,CLEN),1:COMMENT)
S $P(DATAOUT,"^",8)=ZZ ; Comment
S $P(DATAOUT,"^",9)=COMIEN ; IEN of the Comment
S $P(DATAOUT,"^",10)=CNT ; Comment Number
S:'NOSET ^TMP($J,"IBCNCHIX",CNT)=DATAOUT
Q DATAOUT
;
SETL(LINE,DATA,LABEL,COL,LNG) ; Creates a line of data to be set into the body
; of the worklist
; Input: LINE - Current line being created
; DATA - Information to be added to the end of the current line
; LABEL - Label to describe the information being added
; COL - Column position in line to add information add
; LNG - Maximum length of data information to include on the line
; Returns: Line updated with added information
S LINE=LINE_$J("",(COL-$L(LABEL)-$L(LINE)))_LABEL_$E(DATA,1,LNG)
Q LINE
;
SEARCH(COMIN) ;EP
; Protocol action to Search Patient Policy Comments for selected text
; Input: COMIN - IEN of the selected Patient Policy Comment
; Optional - Only sent when called from the expanded
; comment listman template.
; DFN - IEN of the selected Patient
; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
; multiple IEN of the selected Patient Policy
N FOUND,STEXT
S VALMBCK="R"
D FULL^VALM1
S STEXT=$$GETSTXT() ; Get the text to search for
I STEXT="" D Q
. W !!,*7,"No search text selected."
. D PAUSE^VALM1
;
; Search all of the Patient Policy Comments for the specified search text
D SEARCHC(DFN,IBIIEN,STEXT,.FOUND)
I 'FOUND D Q
. W !!,*7,STEXT," not found in any Patient Policy Comments."
. D PAUSE^VALM1
;
; Display all the Patient Policy Comments where the text was found
W !!,STEXT," was found in ",FOUND," Patient Policy Comment(s)."
W !,"The found text will be highlighted within each comment in the Expanded Entry"
W !,"display.",!!
Q:'$$ASKYN^IBCNCH("View the results now",1)
D SEARCH^IBCNCH3(DFN,IBIIEN,STEXT,.FOUND)
Q
;
GETSTXT() ; Get the text to search for
; Input: None
; Returns: text to search for or "" if not entered
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="F",DIR("A")="Enter the text to search for"
D ^DIR
Q Y
;
SEARCHC(DFN,IBIIEN,STEXT,FOUND) ; Search all the Patient Policy Comments
; Input: DFN - IEN of the Patient
; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the multiple
; IEN of the selected Patient Policy
; STEXT - Text to search for
; Output: FOUND - Array of Patient Policy Comments
; FOUND - A1
; FOUND(0,CTR) - A2
; FOUND(1,A2) - CTR
; Where: A1 - Number of comments where text was found
; A2 - IEN of the comment where text was found
; CTR- Counter to put sort comments by date
N CNT,COMDT,COMIEN
S (CNT,FOUND)=0,COMDT=""
F D Q:COMDT=""
. S COMDT=$O(^DPT(DFN,.312,IBIIEN,13,"B",COMDT),-1)
. Q:COMDT=""
. S COMIEN=""
. F D Q:COMIEN=""
. . S COMIEN=$O(^DPT(DFN,.312,IBIIEN,13,"B",COMDT,COMIEN),-1)
. . Q:COMIEN=""
. . Q:'$$FOUNDT(DFN,IBIIEN,COMIEN,STEXT)
. . S CNT=CNT+1,FOUND=FOUND+1
. . S FOUND(0,CNT)=COMIEN,FOUND(1,COMIEN)=CNT
Q
;
FOUNDT(DFN,IBIIEN,COMIEN,STEXT) ; Search the specified comment for the
; specified text
; Input: DFN - IEN of the 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
; STEXT - Text to search for
; Returns: 1 if the STEXT was found, 0 otherwise
N IENS,XX
S IENS=COMIEN_","_IBIIEN_","_DFN_","
S STEXT=$$UP^XLFSTR(STEXT)
S XX=$$UP^XLFSTR($$GET1^DIQ(2.342,IENS,.04))
I XX[STEXT Q 1 ; Search Contact Person
S XX=$$UP^XLFSTR($$GET1^DIQ(2.342,IENS,.05))
I XX[STEXT Q 1 ; Search Contact Phone
S XX=$$UP^XLFSTR($$GET1^DIQ(2.342,IENS,.07))
I XX[STEXT Q 1 ; Search Method
S XX=$$UP^XLFSTR($$GET1^DIQ(2.342,IENS,.06))
I XX[STEXT Q 1 ; Search Call Reference #
S XX=$$UP^XLFSTR($$GET1^DIQ(2.342,IENS,.08))
I XX[STEXT Q 1 ; Search Authorization #
S XX=$$UP^XLFSTR($$GET1^DIQ(2.342,IENS,.03))
I XX[STEXT Q 1 ; Search Comment Text
Q 0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNCH2 11030 printed Nov 22, 2024@17:24:23 Page 2
IBCNCH2 ;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 Comments - 1. Build main insurance comment display
+5 ; 2. Search Comments for a specified String
+6 ;
BLD(DFN,IBIIEN) ;EP
+1 ; Build the listman template body of the main Insurance Comment display
+2 ; Input: DFN - IEN of the patient
+3 ; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
+4 ; multiple IEN of the selected patient policy
+5 ; ^TMP($J,"IBCNCHIX",CNT) - See GETCOMS
+6 NEW CNT,LINE,LN,XX
+7 DO GETCOMS(DFN,IBIIEN)
+8 SET VALMCNT=0
SET LINE=""
SET CNT=""
+9 ;
+10 FOR
Begin DoDot:1
+11 SET CNT=$ORDER(^TMP($JOB,"IBCNCHIX",CNT))
+12 if CNT=""
QUIT
+13 IF CNT'=1
Begin DoDot:2
+14 SET VALMCNT=VALMCNT+1
+15 DO SET^VALM10(VALMCNT,"",VALMCNT)
End DoDot:2
+16 ;
+17 SET VALMCNT=VALMCNT+1
+18 DO BLDONEC(.VALMCNT,CNT)
End DoDot:1
if CNT=""
QUIT
+19 ;
+20 IF VALMCNT=0
Begin DoDot:1
+21 SET VALMCNT=1
SET XX=" *** No comments to display ***"
+22 DO SET^VALM10(VALMCNT,XX,VALMCNT)
End DoDot:1
+23 QUIT
+24 ;
BLDONEC(VALMCNT,COMCNT) ; (Re)Build one comment into the listman display
+1 ; Called from BLD and after adding or editing a comment
+2 ; Input: VALMCNT - Current Line of the display being
+3 ; (re)built
+4 ; COMCNT - Comment Number
+5 ; ^TMP($J,"IBCNCHIX",COMCNT) - See GETONEC for details
+6 ; Output: VALMCNT - Updated Line of the display being
+7 ; (re)built
+8 NEW DATALN,LINE
+9 ; Comment #
SET LINE=$$SETL("",COMCNT,"",1,4)
+10 SET DATALN=^TMP($JOB,"IBCNCHIX",COMCNT)
+11 ; Dt Entered
SET XX=$PIECE(DATALN,"^",1)
+12 SET LINE=$$SETL(LINE,XX,"",6,15)
+13 DO SET^VALM10(VALMCNT,LINE,VALMCNT)
+14 ; Entered By
SET XX=$PIECE(DATALN,"^",2)
+15 SET LINE=$$SETL(LINE,XX,"",18,37)
+16 DO SET^VALM10(VALMCNT,LINE,VALMCNT)
+17 ; Method
SET XX=$PIECE(DATALN,"^",4)
+18 SET LINE=$$SETL(LINE,XX,"",44,52)
+19 DO SET^VALM10(VALMCNT,LINE,VALMCNT)
+20 ; Person Contacted
SET XX=$PIECE(DATALN,"^",3)
+21 SET LINE=$$SETL(LINE,XX,"",55,80)
+22 DO SET^VALM10(VALMCNT,LINE,VALMCNT)
+23 SET VALMCNT=VALMCNT+1
+24 ; Start of Comment
SET XX=$EXTRACT($PIECE(DATALN,"^",8),1,132)
+25 SET LINE=$$SETL("",XX,"",6,80)
+26 DO SET^VALM10(VALMCNT,LINE,VALMCNT)
+27 QUIT
+28 ;
GETCOMS(DFN,IBIIEN) ; Retrieves the policy comments for the selected
+1 ; patient and policy in most recent date order
+2 ; Input: DFN - IEN of the patient
+3 ; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
+4 ; multiple IEN of the selected patient policy
+5 ; Output: ^TMP($J,"IBCNCHIX",CNT) - A1^A2^A3^A4^A5^A6^A7^A8^A9^A10
+6 ; See GETONEC for detailed explanation
+7 NEW CNT,COMDT,COMIEN
+8 SET CNT=0
SET COMDT=""
+9 FOR
Begin DoDot:1
+10 SET COMDT=$ORDER(^DPT(DFN,.312,IBIIEN,13,"B",COMDT),-1)
+11 if COMDT=""
QUIT
+12 SET COMIEN=""
+13 FOR
Begin DoDot:2
+14 SET COMIEN=$ORDER(^DPT(DFN,.312,IBIIEN,13,"B",COMDT,COMIEN),-1)
+15 if COMIEN=""
QUIT
+16 SET CNT=CNT+1
+17 ; Get One Comment
DO GETONEC(DFN,IBIIEN,COMIEN,CNT)
End DoDot:2
if COMIEN=""
QUIT
End DoDot:1
if COMDT=""
QUIT
+18 QUIT
+19 ;
GETONEC(DFN,IBIIEN,COMIEN,CNT,CLEN,FULL,NOSET) ;EP
+1 ; Get the Data for a specified Policy Comment
+2 ; Input: DFN - IEN of the patient
+3 ; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
+4 ; multiple IEN of the selected patient policy
+5 ; COMIEN - ^DPT(DFN,.312,IBIIEN,13,COMIEN,0) Where
+6 ; COMIEN is the multiple IEN of the selected
+7 ; Patient Policy Comment
+8 ; CNT - Current Comment Selection Number
+9 ; CLEN - Length of Partial Comment to be displayed
+10 ; Optional, defaults to 74
+11 ; FULL - 1 to return the full comment text,
+12 ; otherwise
+13 ; Optional - defaults to 0
+14 ; NOSET - 1 to not set into ^TMP, 0 otherwise
+15 ; Optional, defaults to 0
+16 ; Output: NOTE: ^TMP($J,"IBCNCHIX",CNT) only set if NOSET=0
+17 ; ^TMP($J,"IBCNCHIX",CNT) - A1^A2^A3^A4^A5^A6^A7^A8^A9^A10
+18 ; Where:
+19 ; CNT - Comment selection # (comments ordered by
+20 ; (date entered)
+21 ; A1 - External date/time the comment was entered
+22 ; NOTE: has a leading '+' when A8 > CLEN
+23 ; A2 - External User Name of the user who entered
+24 ; the comment
+25 ; A3 - Person Contacted
+26 ; A4 - Method of Contact
+27 ; A5 - Contact Phone #
+28 ; A6 - Call Reference #
+29 ; A7 - Authorization #
+30 ; A8 - Comment
+31 ; A9 - Patient Policy Comment IEN
+32 ; A10 - Comment Selection Number
+33 NEW COMMENT,DATAOUT,IENS,XX,ZZ
+34 if '$DATA(FULL)
SET FULL=0
+35 if '$DATA(NOSET)
SET NOSET=0
+36 if '$DATA(CLEN)
SET CLEN=74
+37 SET IENS=COMIEN_","_IBIIEN_","_DFN_","
+38 ; Comment Text
SET COMMENT=$$GET1^DIQ(2.342,IENS,.03)
+39 ; Internal Date/Time entered
SET XX=$$GET1^DIQ(2.342,IENS,.01,"I")
+40 ; Truncated Comment Indicator
SET ZZ=$SELECT($LENGTH(COMMENT)>CLEN:"+",1:" ")
+41 SET DATAOUT=ZZ_$$FMTE^XLFDT($PIECE(XX,"^",1),"2DZ")
+42 ; IEN of Last Edited By User
SET XX=$$GET1^DIQ(2.342,IENS,.02,"I")
+43 ; Entered by user
SET ZZ=$$GET1^DIQ(200,XX,.01)
+44 SET $PIECE(DATAOUT,"^",2)=$EXTRACT(ZZ,1,24)
+45 ; Person Contacted
SET $PIECE(DATAOUT,"^",3)=$$GET1^DIQ(2.342,IENS,.04)
+46 SET ZZ=$$GET1^DIQ(2.342,IENS,.07)
+47 ; Method of Contact
SET $PIECE(DATAOUT,"^",4)=$EXTRACT(ZZ,1,10)
+48 ; Contact Phone #
SET $PIECE(DATAOUT,"^",5)=$$GET1^DIQ(2.342,IENS,.05)
+49 ; Call Reference #
SET $PIECE(DATAOUT,"^",6)=$$GET1^DIQ(2.342,IENS,.06)
+50 ; Authorization #
SET $PIECE(DATAOUT,"^",7)=$$GET1^DIQ(2.342,IENS,.08)
+51 SET ZZ=$SELECT('FULL:$EXTRACT(COMMENT,1,CLEN),1:COMMENT)
+52 ; Comment
SET $PIECE(DATAOUT,"^",8)=ZZ
+53 ; IEN of the Comment
SET $PIECE(DATAOUT,"^",9)=COMIEN
+54 ; Comment Number
SET $PIECE(DATAOUT,"^",10)=CNT
+55 if 'NOSET
SET ^TMP($JOB,"IBCNCHIX",CNT)=DATAOUT
+56 QUIT DATAOUT
+57 ;
SETL(LINE,DATA,LABEL,COL,LNG) ; Creates a line of data to be set into the body
+1 ; of the worklist
+2 ; Input: LINE - Current line being created
+3 ; DATA - Information to be added to the end of the current line
+4 ; LABEL - Label to describe the information being added
+5 ; COL - Column position in line to add information add
+6 ; LNG - Maximum length of data information to include on the line
+7 ; Returns: Line updated with added information
+8 SET LINE=LINE_$JUSTIFY("",(COL-$LENGTH(LABEL)-$LENGTH(LINE)))_LABEL_$EXTRACT(DATA,1,LNG)
+9 QUIT LINE
+10 ;
SEARCH(COMIN) ;EP
+1 ; Protocol action to Search Patient Policy Comments for selected text
+2 ; Input: COMIN - IEN of the selected Patient Policy Comment
+3 ; Optional - Only sent when called from the expanded
+4 ; comment listman template.
+5 ; DFN - IEN of the selected Patient
+6 ; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
+7 ; multiple IEN of the selected Patient Policy
+8 NEW FOUND,STEXT
+9 SET VALMBCK="R"
+10 DO FULL^VALM1
+11 ; Get the text to search for
SET STEXT=$$GETSTXT()
+12 IF STEXT=""
Begin DoDot:1
+13 WRITE !!,*7,"No search text selected."
+14 DO PAUSE^VALM1
End DoDot:1
QUIT
+15 ;
+16 ; Search all of the Patient Policy Comments for the specified search text
+17 DO SEARCHC(DFN,IBIIEN,STEXT,.FOUND)
+18 IF 'FOUND
Begin DoDot:1
+19 WRITE !!,*7,STEXT," not found in any Patient Policy Comments."
+20 DO PAUSE^VALM1
End DoDot:1
QUIT
+21 ;
+22 ; Display all the Patient Policy Comments where the text was found
+23 WRITE !!,STEXT," was found in ",FOUND," Patient Policy Comment(s)."
+24 WRITE !,"The found text will be highlighted within each comment in the Expanded Entry"
+25 WRITE !,"display.",!!
+26 if '$$ASKYN^IBCNCH("View the results now",1)
QUIT
+27 DO SEARCH^IBCNCH3(DFN,IBIIEN,STEXT,.FOUND)
+28 QUIT
+29 ;
GETSTXT() ; Get the text to search for
+1 ; Input: None
+2 ; Returns: text to search for or "" if not entered
+3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+4 SET DIR(0)="F"
SET DIR("A")="Enter the text to search for"
+5 DO ^DIR
+6 QUIT Y
+7 ;
SEARCHC(DFN,IBIIEN,STEXT,FOUND) ; Search all the Patient Policy Comments
+1 ; Input: DFN - IEN of the Patient
+2 ; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the multiple
+3 ; IEN of the selected Patient Policy
+4 ; STEXT - Text to search for
+5 ; Output: FOUND - Array of Patient Policy Comments
+6 ; FOUND - A1
+7 ; FOUND(0,CTR) - A2
+8 ; FOUND(1,A2) - CTR
+9 ; Where: A1 - Number of comments where text was found
+10 ; A2 - IEN of the comment where text was found
+11 ; CTR- Counter to put sort comments by date
+12 NEW CNT,COMDT,COMIEN
+13 SET (CNT,FOUND)=0
SET COMDT=""
+14 FOR
Begin DoDot:1
+15 SET COMDT=$ORDER(^DPT(DFN,.312,IBIIEN,13,"B",COMDT),-1)
+16 if COMDT=""
QUIT
+17 SET COMIEN=""
+18 FOR
Begin DoDot:2
+19 SET COMIEN=$ORDER(^DPT(DFN,.312,IBIIEN,13,"B",COMDT,COMIEN),-1)
+20 if COMIEN=""
QUIT
+21 if '$$FOUNDT(DFN,IBIIEN,COMIEN,STEXT)
QUIT
+22 SET CNT=CNT+1
SET FOUND=FOUND+1
+23 SET FOUND(0,CNT)=COMIEN
SET FOUND(1,COMIEN)=CNT
End DoDot:2
if COMIEN=""
QUIT
End DoDot:1
if COMDT=""
QUIT
+24 QUIT
+25 ;
FOUNDT(DFN,IBIIEN,COMIEN,STEXT) ; Search the specified comment for the
+1 ; specified text
+2 ; Input: DFN - IEN of the Patient
+3 ; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the multiple
+4 ; IEN of the selected Patient Policy
+5 ; COMIEN - IEN of the selected Patient Policy Comment
+6 ; STEXT - Text to search for
+7 ; Returns: 1 if the STEXT was found, 0 otherwise
+8 NEW IENS,XX
+9 SET IENS=COMIEN_","_IBIIEN_","_DFN_","
+10 SET STEXT=$$UP^XLFSTR(STEXT)
+11 SET XX=$$UP^XLFSTR($$GET1^DIQ(2.342,IENS,.04))
+12 ; Search Contact Person
IF XX[STEXT
QUIT 1
+13 SET XX=$$UP^XLFSTR($$GET1^DIQ(2.342,IENS,.05))
+14 ; Search Contact Phone
IF XX[STEXT
QUIT 1
+15 SET XX=$$UP^XLFSTR($$GET1^DIQ(2.342,IENS,.07))
+16 ; Search Method
IF XX[STEXT
QUIT 1
+17 SET XX=$$UP^XLFSTR($$GET1^DIQ(2.342,IENS,.06))
+18 ; Search Call Reference #
IF XX[STEXT
QUIT 1
+19 SET XX=$$UP^XLFSTR($$GET1^DIQ(2.342,IENS,.08))
+20 ; Search Authorization #
IF XX[STEXT
QUIT 1
+21 SET XX=$$UP^XLFSTR($$GET1^DIQ(2.342,IENS,.03))
+22 ; Search Comment Text
IF XX[STEXT
QUIT 1
+23 QUIT 0
+24 ;
