IBCNCH ;ALB/FA - PATIENT POLICY COMMENT HISTORY ;05-MAR-2015
;;2.0;INTEGRATED BILLING;**549,582,652**;21-MAR-94;Build 23
;;Per VA Directive 6402, this routine should not be modified.
;
EN(DFN,IBIIEN,MODE) ;EP
; Main entry point
; Input: DFN - IEN of the patient
; IBIIEN - IEN of patient policy multiple (^DPT(DFN,.312,IBIIEN)
; MODE - 1 - User is allowed to Add/Edit/Delete/View/Search comments
; 0 - User is allowed to View/Search comments
K VALMQUIT
I $G(DFN)="" D Q
. W !!,*7,"Patient is not identified."
. D PAUSE^VALM1
I +$G(IBIIEN)<0 D Q
. W !!,*7,"Patient Policy is not identified."
. D PAUSE^VALM1
S:'$D(MODE) MODE=0
;
I MODE=1 D EN^VALM("IBCNCH POLICY COMMENT HISTORY") Q
D EN^VALM("IBCNCH POLICY COMMENT VIEW")
Q
;
HDR ;EP
; Build the listman template header information
; Input: DFN - IEN of the patient
; IBPPOL - ^DPT(DFN,.312,PIEN,0) Where PIEN is the IEN of the
; selected patient policy
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)
Q
;
INIT ;EP
; Initialize the listman template
; 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("IBCNCH",$J) - Body lines to display for specified template
; ^TMP($J,"IBCNCHIX") - Index of displayed comments (see GETCOMS)
K ^TMP("IBCNCH",$J),^TMP($J,"IBCNCHIX")
D BLD^IBCNCH2(DFN,IBIIEN)
Q
;
ADDCOM ;EP
; Protocol action to Add a new Patient Policy Comment
; Input: DFN - IEN of the selected Patient
; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
; multiple IEN of the selected patient policy
N COMDT,COMIEN,DA,DIE,DR,DTOUT,XX
D FULL^VALM1
S VALMBCK="R"
;
; If last comment entered today by this user, edit it instead of adding
; a new one
S COMDT=$O(^DPT(DFN,.312,IBIIEN,13,"B",""),-1)
I COMDT'="" D
. S COMIEN=$O(^DPT(DFN,.312,IBIIEN,13,"B",COMDT,""))
. S XX=$$GET1^DIQ(2.342,COMIEN_","_IBIIEN_","_DFN_",",.02,"I")
I COMDT'="",XX=DUZ,$P(COMDT,".",1)=$P($$NOW^XLFDT(),".",1) D Q
. D EDITCOM(DFN,IBIIEN,COMIEN,0)
;
; Lock Adding of comments for this patient and policy
I '$$LOCKN(DFN,IBIIEN) D Q
. W !!,*7,"Someone else is adding a comment for this patient and policy."
. W !,"Try again later."
. D PAUSE^VALM1
S COMIEN=$$NEXTCOM(DFN,IBIIEN) ; Get next Comment IEN
;
; Let the user add the comment
S DIE="^DPT(DFN,.312,IBIIEN,13,"
S DA=COMIEN,DA(1)=IBIIEN,DA(2)=DFN
S DR=".04Person Contacted;.05Contact Person Phone;.07Contact Method"
S DR=DR_";.06Call Reference Number;.08Authorization Number;.03Comment"
D ^DIE
;
; Check to make sure a comment was actually entered
I $$DELCOM(DFN,IBIIEN,COMIEN) D Q
. W !!,*7,"No Comment was entered. Nothing Filed"
. D PAUSE^VALM1
. D UNLOCKN(DFN,IBIIEN)
;
D UNLOCKN(DFN,IBIIEN)
D INIT ; Rebuild the list
Q
;
NEXTCOM(DFN,IBIIEN) ; Get the next available Patient Policy Comment IEN for
; the selected Patient and Policy
; Input: DFN - IEN of the selected Patient
; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
; multiple IEN of the selected patient policy
; DUZ - IEN of the user creating the comment
; Returns: IEN number of newly created Patient Policy Comment
N ERRMSG,FDA,IENS,NOW,RETIEN
S NOW=$$NOW^XLFDT()
S IENS="+1,"_IBIIEN_","_DFN_","
S FDA(2.342,IENS,.01)=NOW ; Date/Time of the comment
S FDA(2.342,IENS,.02)=DUZ ; User adding the comment
D UPDATE^DIE("","FDA","RETIEN","ERRMSG") ; File new policy comment shell
Q RETIEN(1)
;
LOCKN(DFN,IBIIEN) ; Lock Adding of comments for a specified patient
; and policy
; Input: DFN - IEN of the Patient a comment will be added for
; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
; multiple IEN of the selected patient policy
; Returns: 1 - Lock was obtained, 0 otherwise
L +^POLCOM(DFN,IBIIEN):3
I '$T Q 0
Q 1
;
UNLOCKN(DFN,IBIIEN) ; Unlock Adding of comments for a specified patient
; Input: DFN - IEN of the Patient a comment will be added for
; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
; multiple IEN of the selected patient policy
L -^POLCCOM(DFN,IBIIEN)
Q
;
DELETE(COMIN) ;EP
; Protocol action to Delete a (or multiple) Patient Policy Comment(s)
; Input: COMIN - IEN of the selected Patient Policy Comment(s)
; 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 COMIEN,DA,DLTDONE,DIK,FROMEE,MULTI ; IB*2.0*652-Added DLTDONE & MULTI
S VALMBCK="R",MULTI=0
D FULL^VALM1
S COMIEN=$S($D(COMIN):COMIN,1:"")
S FROMEE=$S(COMIEN'="":1,1:0)
;
;/vd-IB*2*652-Beginning of delete comment code
;Does user have IBCN PT POLICY COMNT DELETE security key to delete any comment?
N COMIENS,IBKEY,IBSUP S IBSUP=0
D OWNSKEY^XUSRB(.IBKEY,"IBCN PT POLICY COMNT DELETE",DUZ) ; IA 3277
S:IBKEY(0)=1 IBSUP=1
; If user has IBCN PT POLICY COMNT DELETE key allow multi-delete.
; Not allowed from expanded comments.
I IBSUP,'COMIEN D Q
. N SELERR S SELERR=0
. S MULTI=1
. S:COMIEN="" COMIEN=$$MULTCOM^IBCNCH(1,"Select Comment(s) to delete","","IBCNCHIX")
. Q:COMIEN=""
. ;
. ;Loop thru multi-selections & create array of comments to delete.
. N ARYCNT,ARYNO,ARYNUMS,IBI,IBI1,IBI2
. S COMIEN=$TR(COMIEN,";",",") ; Translate ";" to "," to easily piece apart line.
. S ARYCNT=$L(COMIEN,",") ; Get # of params to delete
. F IBI=1:1:ARYCNT D Q:SELERR
.. S ARYNO=$P(COMIEN,",",IBI)
.. I ARYNO'["-",$D(^TMP($J,"IBCNCHIX",ARYNO)) S ARYNUMS(ARYNO)="" Q ; Capture param as a single entry.
.. I ARYNO'["-" S SELERR=1 Q ; Invalid entry
.. S IBI1=$P(ARYNO,"-"),IBI2=$P(ARYNO,"-",2) ; Get a selected range
.. I '$D(^TMP($J,"IBCNCHIX",IBI1))!'$D(^TMP($J,"IBCNCHIX",IBI2)) S SELERR=1 Q ; Invalid entry
.. F IBI=IBI1:1:IBI2 S ARYNUMS(IBI)="" ; Get the range of #s
.. Q
. I SELERR D Q ; If an invalid entry was made display error message.
.. W !,*7,">>>> Invalid selection number"
.. K DIR
.. D PAUSE^VALM1
. ;
. I $$ASKYN("Are you sure you want to Delete "_$S(((COMIEN["-")!(COMIEN[",")):"these Comments",1:"this Comment")) D
.. ;Loop thru array of comments to delete
.. S ARYNO=""
.. F S ARYNO=$O(ARYNUMS(ARYNO)) Q:ARYNO="" D
... S COMIEN=+$P(^TMP($J,"IBCNCHIX",ARYNO),U,9) Q:'COMIEN
... S DLTDONE=0 D DELETIT(COMIEN,MULTI,DLTDONE)
.. ;
. I FROMEE=1 S VALMBCK="Q" Q
. D INIT
. Q
;/vd-IB*2*652-End of delete comment code
;
S:COMIEN="" COMIEN=$$SELCOM(1,"Select Comment to delete","","IBCNCHIX")
Q:COMIEN=""
;
;/vd-IB*2.0*652-The following is if the user doesn't have the IBCN PT POLICY COMMNT DELETE key...MULTI=0.
S DLTDONE=0 D DELETIT(COMIEN,MULTI,.DLTDONE)
;
;I FROMEE=1 S VALMBCK="Q" Q ;/vd-IB*2.0*652-Replaced this line of code with the following.
I FROMEE=1 D Q
. I 'DLTDONE S VALMBCK="R" Q ; If in 'EE' & didn't delete a comment, stay in 'EE'.
. I DLTDONE=1 S VALMBCK="Q" ; If in 'EE' & the comment is deleted, exit 'EE' & return to list of comments.
;
D INIT ; Rebuild the list
Q
;
DELETIT(COMIEN,MULTI,DLTDONE) ; Lock Deletion of this patient policy comment
; COMIEN = comment to be deleted.
; MULTI = 0 - display OK TO DELETE question per normal.
; = 1 - display OK TO DELETE question once for all selected comments.
; DLTDONE = 0 - selection not deleted.
; = 1 - selection deleted.
N XX S XX=0
I '$$LOCKC(DFN,IBIIEN,COMIEN) D Q
. W !!,*7,"Someone is editing or deleting this Patient Policy Comment."
. W !,"Try again later."
. D PAUSE^VALM1
;
; Ok to delete this comment?
I 'MULTI S XX=$$OK2EDIT(DFN,IBIIEN,COMIEN,"Delete")
I +XX=-1 D Q ; Unable to delete
. D UNLOCKC(DFN,IBIIEN,COMIEN)
. N IL,IMX
. S IMX=$l(XX,"^") ; Determine the max # of lines that are to be printed.
. W *7
. S IL=2 F IL=IL:1:IMX D ; Since the 1st piece is not part of the comment, start w/the 2nd piece & display up to the max.
. . W !,$P(XX,"^",IL)
. D PAUSE^VALM1
;
; Give final Warning
I 'MULTI,'$$ASKYN("Are you sure you want to Delete this Comment") D Q
. D UNLOCKC(DFN,IBIIEN,COMIEN)
;
S DA=COMIEN,DA(1)=IBIIEN,DA(2)=DFN
S DIK="^DPT(DA(2),.312,DA(1),13,"
D ^DIK ; Delete the Patient Policy Comment
D UNLOCKC(DFN,IBIIEN,COMIEN)
S DLTDONE=1
Q
;/vd-IB*2.0*652-End of new code for enhanced deleting of Patient Policy Comments
;
ASKYN(PROMPT,DEFAULT) ; Ask a yes/no question
; Input: PROMPT - Question to be asked
; DEFAULT - Default Answer
; 1 - YES, 0 - NO
; Optional, defaults to 0
; Returns: 1 - User answered YES, 0 otherwise
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S:$G(DEFAULT)'=1 DEFAULT=0
S DIR(0)="Y",DIR("A")=PROMPT
S DIR("B")=$S(DEFAULT:"YES",1:"NO")
D ^DIR
Q Y
;
EDIT(COMIN) ;EP
; Protocol action to Edit a Patient Policy Comment Fields
; 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 COMCNT,COMIEN,DA,DIC,DIE,DO,DR,DTOUT,EDT,FROMEE,LINE,SRCHTXT,X,XX,Y
S COMIEN=$S($D(COMIN):COMIN,1:"")
S FROMEE=$S(COMIEN'="":1,1:0)
S VALMBCK="R"
D FULL^VALM1
S:COMIEN="" COMIEN=$$SELCOM(1,"Select Comment to edit",.COMCNT,"IBCNCHIX")
Q:COMIEN=""
D EDITCOM(DFN,IBIIEN,COMIEN,FROMEE)
Q
;
EDITCOM(DFN,IBIIEN,COMIEN,FROMEE) ; Edit the selected comment
; Called from EDIT and ADDCOM
; 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 comment being edited
; FROMEE - 1 edit from Expand Entry, 0 otherwise
; Optional, defaults to 0
S:'$D(FROMEE) FROMEE=0
;
; Lock Editing of this patient policy comment
I '$$LOCKC(DFN,IBIIEN,COMIEN) D Q
. W !!,*7,"Someone else is editing or deleting this Patient Policy Comment."
. W !,"Try again later."
. D PAUSE^VALM1
;
; Ok to edit this comment?
S XX=$$OK2EDIT(DFN,IBIIEN,COMIEN,"Edit")
I +XX=-1 D Q ; Unable to edit
. D UNLOCKC(DFN,IBIIEN,COMIEN)
. W !,*7,$P(XX,"^",2)
. D PAUSE^VALM1
;
; Let the user edit the comment
S EDT=$$NOW^XLFDT()
S DIE="^DPT(DFN,.312,IBIIEN,13,"
S DA=COMIEN,DA(1)=IBIIEN,DA(2)=DFN
;/vd-IB*2*652 - Added 4th dashes to prevent re-validating problem from occuring in ^DIE.
S DR=".01////"_EDT_";.02////"_DUZ_";.04Person Contacted;.05Contact Person Phone"
S DR=DR_";.07Contact Method;.06Call Reference Number;.08Authorization Number"
S DR=DR_";.03Comment"
D ^DIE
D UNLOCKC(DFN,IBIIEN,COMIEN)
I FROMEE D INIT^IBCNCH3 Q
D INIT ; Rebuild the list
Q
;
OK2EDIT(DFN,IBIIEN,COMIEN,WHICH) ; Check to see if it's ok to Edit/Delete the
; selected Patient Policy Comment
; 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
; WHICH - 'Delete' when called from DELETE
; 'Edit' whe called fomr EDIT
; Returns: 1 - OK to edit or delete, -1^Error Message otherwise
N COMDT,OK,TDT,XX
S OK=1 ; Assume it's OK
;
; Make sure the selected comment is the latest comment
S COMDT=$O(^DPT(DFN,.312,IBIIEN,13,"B",""),-1)
S XX=$O(^DPT(DFN,.312,IBIIEN,13,"B",COMDT,""))
I COMIEN'=XX D Q OK
. I WHICH="Delete",+$G(IBSUP) Q ;\vd - IB*2*652 - If in DELETE mode need to have proper Security Key to delete.
. S OK="-1^Unable to "_WHICH_". Selected comment is not the latest comment."
. I WHICH="Delete" S OK=OK_"^Contact your supervisor for assistance. " ;/vd - IB*2.0*652 - Added the part about contacting your super.
;
; Make sure the user trying to edit or delete is the user who entered the
; comment
S XX=$$GET1^DIQ(2.342,COMIEN_","_IBIIEN_","_DFN_",",.02,"I")
I XX'=DUZ D Q OK
. I WHICH="Delete",+$G(IBSUP) Q ;\vd - IB*2*652 - If in DELETE mode need to have proper Security Key to delete.
. S OK="-1^Unable to "_WHICH_". Selected comment was entered by a different user."
. I WHICH="Delete" S OK=OK_"^Contact your supervisor for assistance. " ;/vd - IB*2.0*652 - Added the part about contacting your super.
;
; Make sure today's date is the same as when the comment was last edited
; comment
S XX=$$GET1^DIQ(2.342,COMIEN_","_IBIIEN_","_DFN_",",.01,"I")
S XX=$P(XX,".",1)
S TDT=$$NOW^XLFDT(),TDT=$P(TDT,".",1)
I XX'=TDT D Q OK
. I WHICH="Delete",+$G(IBSUP) Q ;\vd - IB*2*652 - If in DELETE mode need to have proper Security Key to delete.
. S OK="-1^Unable to "_WHICH_". Selected comment is outside the "_WHICH_" window."
. I WHICH="Delete" S OK=OK_"^Contact your supervisor for assistance. " ;/vd - IB*2.0*652 - Added the part about contacting your super.
Q OK
;
LOCKC(DFN,IBIIEN,COMIEN) ; Lock Editing of a selected Patient Policy Comment
; Input: DFN - IEN of the Patient a comment will be added for
; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
; multiple IEN of the selected patient policy
; COMIEN - IEN of the Patient Policy comment being edited
; Returns: 1 - Lock was obtained, 0 otherwise
L +^POLCOM(DFN,IBIIEN,COMIEN):3
I '$T Q 0
Q 1
;
UNLOCKC(DFN,IBIIEN,COMIEN) ; Unlock Editing of a selected Patient Policy Comment
; Input: DFN - IEN of the Patient a comment will be added for
; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
; multiple IEN of the selected patient policy
; COMIEN - IEN of the Patient Policy comment being edited
L -^POLCCOM(DFN,IBIIEN,COMIEN)
Q
;
HELP ;EP
; Display the listman template help
N X
S X="?"
D DISP^XQORM1
W !!
Q
;
;/vd - IB*2*652 - Beginning of code (delete comment)
;-------------------------------------------------
MULTCOM(FULL,PROMPT,COMCNT,WLIST) ;Allow selection of multiple comments to be deleted
; Select Entry(s) to perform an action upon
; Input: FULL - 1 - full screen mode, 0 otherwise
; PROMPT - Prompt to be displayed to the user
; WLIST - Worklist, the user is selecting from
; ^TMP($J,"IBCNCHIX") - Index of displayed lines of the Comment
; History Worklist
; Output: COMCNT - Comment Number of the selected Comment
; Returns: Select Comment IEN
; Error message if invalid selection
N COMIEN,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,END,START,X,Y
S:'$D(WLIST) WLIST="IBCNCHIX"
S START=1,END=$O(^TMP($J,WLIST,""),-1)+0
D:FULL FULL^VALM1
S COMCNT=$P($P($G(XQORNOD(0)),"^",4),"=",2) ; User selection with action
S COMCNT=$TR(COMCNT,"/\; .",",,,,,") ; Check for multi-selection
;
I '+$G(MULTI),COMCNT["," D Q "" ; /vd - IB-2-652 - MULTI is used to allow for multi-selection for supervisors.
. W !,*7,">>>> Only single entry selection is allowed"
. K DIR
. D PAUSE^VALM1
;
I $O(^TMP($J,"IBCNCHIX",""))="" D Q ""
. S X=$P(PROMPT," ",$L(PROMPT," "))
. W !,*7,">>>> No comments to "_X
. K DIR
. D PAUSE^VALM1
;
S:COMCNT="" COMCNT=$$MLTENTRY(PROMPT,START,END)
Q:((COMCNT="")!(COMCNT="^")) ""
Q COMCNT
;
MLTENTRY(PROMPT,START,END) ; select a comment
; Input: PROMPT - Prompt to be displayed to the user
; START - Start comment # that can be selected
; END - Ending comment # that can be selected
; Returns: Selected Comment # or "" if not selected
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="LC^"_START_":"_END_":0"
S DIR("A")=PROMPT
D ^DIR K DIR
Q X
;-------------------------------------------------
;/vd - IB*2*652 - End of code (delete comment)
;
SELCOM(FULL,PROMPT,COMCNT,WLIST) ;EP
; Select Entry(s) to perform an action upon
; Input: FULL - 1 - full screen mode, 0 otherwise
; PROMPT - Prompt to be displayed to the user
; WLIST - Worklist, the user is selecting from
; ^TMP($J,"IBCNCHIX") - Index of displayed lines of the Comment
; History Worklist
; Output: COMCNT - Comment Number of the selected Comment
; Returns: Select Comment IEN
; Error message if invalid selection
N COMIEN,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,END,START,X,Y
S:'$D(WLIST) WLIST="IBCNCHIX"
S START=1,END=$O(^TMP($J,WLIST,""),-1)+0
D:FULL FULL^VALM1
S COMCNT=$P($P($G(XQORNOD(0)),"^",4),"=",2) ; User selection with action
S COMCNT=$TR(COMCNT,"/\; .",",,,,,") ; Check for multi-selection
;
I COMCNT["," D Q "" ; Invalid multi-selection
. W !,*7,">>>> Only single entry selection is allowed"
. K DIR
. D PAUSE^VALM1
;
I $O(^TMP($J,"IBCNCHIX",""))="" D Q ""
. S X=$P(PROMPT," ",$L(PROMPT," "))
. W !,*7,">>>> No comments to "_X
. K DIR
. D PAUSE^VALM1
;
S:COMCNT="" COMCNT=$$SELENTRY(PROMPT,START,END)
Q:COMCNT="" ""
S COMIEN=$P($G(^TMP($J,"IBCNCHIX",COMCNT)),"^",9)
I COMIEN="" D Q ""
. W !,*7,">>>> Invalid selection number"
. K DIR
. D PAUSE^VALM1
Q COMIEN
;
DELCOM(DFN,IBIIEN,COMIEN) ; Checks to see if the user was attempting to
; create new Patient Policy comment but didn't enter a comment. If so,
; If so, the new Patient Policy Comment is deleted
; Input: DFN - IEN of the Patient a policy comment is being added for
; IBIIEN - IEN of the Policy a policy comment is being added for
; COMIEN - IEN of the new Policy Comment being added
; Returns: 1 - New Patient Policy Comment was deleted, 0 otherwise
;
N DA,DIK,IENS,X,XX,Y
S IENS=COMIEN_","_IBIIEN_","_DFN_","
S XX=$$GET1^DIQ(2.342,IENS,.03) ; Check the comment field
Q:XX'="" 0
S DA=COMIEN,DA(1)=IBIIEN,DA(2)=DFN
S DIK="^DPT(DA(2),.312,DA(1),13,"
D ^DIK ; Delete the multiple
Q 1
;
SELENTRY(PROMPT,START,END) ; select a comment
; Input: PROMPT - Prompt to be displayed to the user
; START - Start comment # that can be selected
; END - Ending comment # that can be selected
; Returns: Selected Comment # or "" if not selected
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="NO^"_START_":"_END_":0"
S DIR("A")=PROMPT
D ^DIR K DIR
Q X
;
EXIT ;EP
; Exit the listman template
K ^TMP("IBCNCH",$J),^TMP($J,"IBCNCHIX")
D CLEAR^VALM1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNCH 19902 printed Dec 13, 2024@02:14:17 Page 2
IBCNCH ;ALB/FA - PATIENT POLICY COMMENT HISTORY ;05-MAR-2015
+1 ;;2.0;INTEGRATED BILLING;**549,582,652**;21-MAR-94;Build 23
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN(DFN,IBIIEN,MODE) ;EP
+1 ; Main entry point
+2 ; Input: DFN - IEN of the patient
+3 ; IBIIEN - IEN of patient policy multiple (^DPT(DFN,.312,IBIIEN)
+4 ; MODE - 1 - User is allowed to Add/Edit/Delete/View/Search comments
+5 ; 0 - User is allowed to View/Search comments
+6 KILL VALMQUIT
+7 IF $GET(DFN)=""
Begin DoDot:1
+8 WRITE !!,*7,"Patient is not identified."
+9 DO PAUSE^VALM1
End DoDot:1
QUIT
+10 IF +$GET(IBIIEN)<0
Begin DoDot:1
+11 WRITE !!,*7,"Patient Policy is not identified."
+12 DO PAUSE^VALM1
End DoDot:1
QUIT
+13 if '$DATA(MODE)
SET MODE=0
+14 ;
+15 IF MODE=1
DO EN^VALM("IBCNCH POLICY COMMENT HISTORY")
QUIT
+16 DO EN^VALM("IBCNCH POLICY COMMENT VIEW")
+17 QUIT
+18 ;
HDR ;EP
+1 ; Build the listman template header information
+2 ; Input: DFN - IEN of the patient
+3 ; IBPPOL - ^DPT(DFN,.312,PIEN,0) Where PIEN is the IEN of the
+4 ; selected patient policy
+5 NEW WW,XX,YY,ZZ
+6 SET XX=$EXTRACT($PIECE(^DPT(DFN,0),"^",1),1,20)_" "_$PIECE($$PT^IBEFUNC(DFN),"^",2)
+7 SET ZZ=$$GET1^DIQ(2,DFN_",",.03)
SET XX=XX_" "_ZZ
+8 SET VALMHDR(1)="Policy Comment History for: "_XX
+9 SET ZZ=$GET(^DPT(DFN,.312,+$PIECE(IBPPOL,"^",4),0))
+10 SET WW=$PIECE($GET(^IBA(355.3,+$PIECE(ZZ,"^",18),0)),"^",11)
+11 SET YY=$EXTRACT($PIECE($GET(^DIC(36,+ZZ,0)),"^",1),1,20)_" Insurance Company"
+12 SET XX="** Plan Currently "_$SELECT(WW:"Ina",1:"A")_"ctive **"
+13 SET VALMHDR(2)=$$SETSTR^VALM1(XX,YY,48,29)
+14 QUIT
+15 ;
INIT ;EP
+1 ; Initialize the listman template
+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("IBCNCH",$J) - Body lines to display for specified template
+6 ; ^TMP($J,"IBCNCHIX") - Index of displayed comments (see GETCOMS)
+7 KILL ^TMP("IBCNCH",$JOB),^TMP($JOB,"IBCNCHIX")
+8 DO BLD^IBCNCH2(DFN,IBIIEN)
+9 QUIT
+10 ;
ADDCOM ;EP
+1 ; Protocol action to Add a new Patient Policy Comment
+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 NEW COMDT,COMIEN,DA,DIE,DR,DTOUT,XX
+6 DO FULL^VALM1
+7 SET VALMBCK="R"
+8 ;
+9 ; If last comment entered today by this user, edit it instead of adding
+10 ; a new one
+11 SET COMDT=$ORDER(^DPT(DFN,.312,IBIIEN,13,"B",""),-1)
+12 IF COMDT'=""
Begin DoDot:1
+13 SET COMIEN=$ORDER(^DPT(DFN,.312,IBIIEN,13,"B",COMDT,""))
+14 SET XX=$$GET1^DIQ(2.342,COMIEN_","_IBIIEN_","_DFN_",",.02,"I")
End DoDot:1
+15 IF COMDT'=""
IF XX=DUZ
IF $PIECE(COMDT,".",1)=$PIECE($$NOW^XLFDT(),".",1)
Begin DoDot:1
+16 DO EDITCOM(DFN,IBIIEN,COMIEN,0)
End DoDot:1
QUIT
+17 ;
+18 ; Lock Adding of comments for this patient and policy
+19 IF '$$LOCKN(DFN,IBIIEN)
Begin DoDot:1
+20 WRITE !!,*7,"Someone else is adding a comment for this patient and policy."
+21 WRITE !,"Try again later."
+22 DO PAUSE^VALM1
End DoDot:1
QUIT
+23 ; Get next Comment IEN
SET COMIEN=$$NEXTCOM(DFN,IBIIEN)
+24 ;
+25 ; Let the user add the comment
+26 SET DIE="^DPT(DFN,.312,IBIIEN,13,"
+27 SET DA=COMIEN
SET DA(1)=IBIIEN
SET DA(2)=DFN
+28 SET DR=".04Person Contacted;.05Contact Person Phone;.07Contact Method"
+29 SET DR=DR_";.06Call Reference Number;.08Authorization Number;.03Comment"
+30 DO ^DIE
+31 ;
+32 ; Check to make sure a comment was actually entered
+33 IF $$DELCOM(DFN,IBIIEN,COMIEN)
Begin DoDot:1
+34 WRITE !!,*7,"No Comment was entered. Nothing Filed"
+35 DO PAUSE^VALM1
+36 DO UNLOCKN(DFN,IBIIEN)
End DoDot:1
QUIT
+37 ;
+38 DO UNLOCKN(DFN,IBIIEN)
+39 ; Rebuild the list
DO INIT
+40 QUIT
+41 ;
NEXTCOM(DFN,IBIIEN) ; Get the next available Patient Policy Comment IEN for
+1 ; the selected Patient and Policy
+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 ; DUZ - IEN of the user creating the comment
+6 ; Returns: IEN number of newly created Patient Policy Comment
+7 NEW ERRMSG,FDA,IENS,NOW,RETIEN
+8 SET NOW=$$NOW^XLFDT()
+9 SET IENS="+1,"_IBIIEN_","_DFN_","
+10 ; Date/Time of the comment
SET FDA(2.342,IENS,.01)=NOW
+11 ; User adding the comment
SET FDA(2.342,IENS,.02)=DUZ
+12 ; File new policy comment shell
DO UPDATE^DIE("","FDA","RETIEN","ERRMSG")
+13 QUIT RETIEN(1)
+14 ;
LOCKN(DFN,IBIIEN) ; Lock Adding of comments for a specified patient
+1 ; and policy
+2 ; Input: DFN - IEN of the Patient a comment will be added for
+3 ; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
+4 ; multiple IEN of the selected patient policy
+5 ; Returns: 1 - Lock was obtained, 0 otherwise
+6 LOCK +^POLCOM(DFN,IBIIEN):3
+7 IF '$TEST
QUIT 0
+8 QUIT 1
+9 ;
UNLOCKN(DFN,IBIIEN) ; Unlock Adding of comments for a specified patient
+1 ; Input: DFN - IEN of the Patient a comment will be added for
+2 ; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
+3 ; multiple IEN of the selected patient policy
+4 LOCK -^POLCCOM(DFN,IBIIEN)
+5 QUIT
+6 ;
DELETE(COMIN) ;EP
+1 ; Protocol action to Delete a (or multiple) Patient Policy Comment(s)
+2 ; Input: COMIN - IEN of the selected Patient Policy Comment(s)
+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 ; IB*2.0*652-Added DLTDONE & MULTI
NEW COMIEN,DA,DLTDONE,DIK,FROMEE,MULTI
+9 SET VALMBCK="R"
SET MULTI=0
+10 DO FULL^VALM1
+11 SET COMIEN=$SELECT($DATA(COMIN):COMIN,1:"")
+12 SET FROMEE=$SELECT(COMIEN'="":1,1:0)
+13 ;
+14 ;/vd-IB*2*652-Beginning of delete comment code
+15 ;Does user have IBCN PT POLICY COMNT DELETE security key to delete any comment?
+16 NEW COMIENS,IBKEY,IBSUP
SET IBSUP=0
+17 ; IA 3277
DO OWNSKEY^XUSRB(.IBKEY,"IBCN PT POLICY COMNT DELETE",DUZ)
+18 if IBKEY(0)=1
SET IBSUP=1
+19 ; If user has IBCN PT POLICY COMNT DELETE key allow multi-delete.
+20 ; Not allowed from expanded comments.
+21 IF IBSUP
IF 'COMIEN
Begin DoDot:1
+22 NEW SELERR
SET SELERR=0
+23 SET MULTI=1
+24 if COMIEN=""
SET COMIEN=$$MULTCOM^IBCNCH(1,"Select Comment(s) to delete","","IBCNCHIX")
+25 if COMIEN=""
QUIT
+26 ;
+27 ;Loop thru multi-selections & create array of comments to delete.
+28 NEW ARYCNT,ARYNO,ARYNUMS,IBI,IBI1,IBI2
+29 ; Translate ";" to "," to easily piece apart line.
SET COMIEN=$TRANSLATE(COMIEN,";",",")
+30 ; Get # of params to delete
SET ARYCNT=$LENGTH(COMIEN,",")
+31 FOR IBI=1:1:ARYCNT
Begin DoDot:2
+32 SET ARYNO=$PIECE(COMIEN,",",IBI)
+33 ; Capture param as a single entry.
IF ARYNO'["-"
IF $DATA(^TMP($JOB,"IBCNCHIX",ARYNO))
SET ARYNUMS(ARYNO)=""
QUIT
+34 ; Invalid entry
IF ARYNO'["-"
SET SELERR=1
QUIT
+35 ; Get a selected range
SET IBI1=$PIECE(ARYNO,"-")
SET IBI2=$PIECE(ARYNO,"-",2)
+36 ; Invalid entry
IF '$DATA(^TMP($JOB,"IBCNCHIX",IBI1))!'$DATA(^TMP($JOB,"IBCNCHIX",IBI2))
SET SELERR=1
QUIT
+37 ; Get the range of #s
FOR IBI=IBI1:1:IBI2
SET ARYNUMS(IBI)=""
+38 QUIT
End DoDot:2
if SELERR
QUIT
+39 ; If an invalid entry was made display error message.
IF SELERR
Begin DoDot:2
+40 WRITE !,*7,">>>> Invalid selection number"
+41 KILL DIR
+42 DO PAUSE^VALM1
End DoDot:2
QUIT
+43 ;
+44 IF $$ASKYN("Are you sure you want to Delete "_$SELECT(((COMIEN["-")!(COMIEN[",")):"these Comments",1:"this Comment"))
Begin DoDot:2
+45 ;Loop thru array of comments to delete
+46 SET ARYNO=""
+47 FOR
SET ARYNO=$ORDER(ARYNUMS(ARYNO))
if ARYNO=""
QUIT
Begin DoDot:3
+48 SET COMIEN=+$PIECE(^TMP($JOB,"IBCNCHIX",ARYNO),U,9)
if 'COMIEN
QUIT
+49 SET DLTDONE=0
DO DELETIT(COMIEN,MULTI,DLTDONE)
End DoDot:3
+50 ;
End DoDot:2
+51 IF FROMEE=1
SET VALMBCK="Q"
QUIT
+52 DO INIT
+53 QUIT
End DoDot:1
QUIT
+54 ;/vd-IB*2*652-End of delete comment code
+55 ;
+56 if COMIEN=""
SET COMIEN=$$SELCOM(1,"Select Comment to delete","","IBCNCHIX")
+57 if COMIEN=""
QUIT
+58 ;
+59 ;/vd-IB*2.0*652-The following is if the user doesn't have the IBCN PT POLICY COMMNT DELETE key...MULTI=0.
+60 SET DLTDONE=0
DO DELETIT(COMIEN,MULTI,.DLTDONE)
+61 ;
+62 ;I FROMEE=1 S VALMBCK="Q" Q ;/vd-IB*2.0*652-Replaced this line of code with the following.
+63 IF FROMEE=1
Begin DoDot:1
+64 ; If in 'EE' & didn't delete a comment, stay in 'EE'.
IF 'DLTDONE
SET VALMBCK="R"
QUIT
+65 ; If in 'EE' & the comment is deleted, exit 'EE' & return to list of comments.
IF DLTDONE=1
SET VALMBCK="Q"
End DoDot:1
QUIT
+66 ;
+67 ; Rebuild the list
DO INIT
+68 QUIT
+69 ;
DELETIT(COMIEN,MULTI,DLTDONE) ; Lock Deletion of this patient policy comment
+1 ; COMIEN = comment to be deleted.
+2 ; MULTI = 0 - display OK TO DELETE question per normal.
+3 ; = 1 - display OK TO DELETE question once for all selected comments.
+4 ; DLTDONE = 0 - selection not deleted.
+5 ; = 1 - selection deleted.
+6 NEW XX
SET XX=0
+7 IF '$$LOCKC(DFN,IBIIEN,COMIEN)
Begin DoDot:1
+8 WRITE !!,*7,"Someone is editing or deleting this Patient Policy Comment."
+9 WRITE !,"Try again later."
+10 DO PAUSE^VALM1
End DoDot:1
QUIT
+11 ;
+12 ; Ok to delete this comment?
+13 IF 'MULTI
SET XX=$$OK2EDIT(DFN,IBIIEN,COMIEN,"Delete")
+14 ; Unable to delete
IF +XX=-1
Begin DoDot:1
+15 DO UNLOCKC(DFN,IBIIEN,COMIEN)
+16 NEW IL,IMX
+17 ; Determine the max # of lines that are to be printed.
