Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNCH

IBCNCH.m

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