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

IBTRH5.m

Go to the documentation of this file.
  1. IBTRH5 ;ALB/FA - HCSR Response Worklist ;18-JUL-2014
  1. ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;
  1. ;
  1. EN(IBFILTSR) ;EP
  1. ; Main entry point for HCSR Response Worklist
  1. ; Input: IBFILTSR - Array of filter options from the HCSR Worklist
  1. ; NOTE: Any modifications done to these filters in the
  1. ; REFRESH menu action are not returned back to
  1. ; HCSR Worklist
  1. N HCSRSRTR
  1. D EN^VALM("IBT HCSR RESPONSE WORKLIST")
  1. Q
  1. ;
  1. HDR ;EP
  1. ; Header code for HCSR Response Worklist
  1. ; Input: HCSSRTR - Current sort selection
  1. ; Output: VALMHDR - Header information to display
  1. ; VALM("TITLE") - HCSR Response Worklist Title
  1. ; VALMSG - Initial Error line display
  1. N SORT
  1. S:$G(HCSRSRTR)="" HCSRSRTR="1^Oldest Entries First"
  1. S SORT=$P(HCSRSRTR,"^",2)
  1. S VALMHDR(1)=$$FILTBY^IBTRH1(.IBFILTSR)
  1. S VALMHDR(2)="Sorted By: "_SORT
  1. S VALM("TITLE")="HCSR Response Worklist"
  1. S VALMSG="#In-Prog"
  1. Q
  1. ;
  1. INIT ;EP
  1. ; Initialize variables and list array
  1. ; Input: None
  1. ; Output: HCSRSRTR - Initial worklist sort if not yet defined
  1. ; ^TMP("IBTRH5",$J) - Body lines to display
  1. K ^TMP("IBTRH5",$J),^TMP($J,"IBTRH5IX")
  1. S:$G(HCSRSRTR)="" HCSRSRTR="1^Oldest Entries First"
  1. D BLD
  1. Q
  1. ;
  1. BLD ; Build screen array, no variables required for input
  1. ; Input: HCSRSRTR - Current select sort type
  1. ; Output: ^TMP("IBTRH5",$J) - Body lines to display
  1. ; ^TMP($J,"IBTRH5S") - Sorted Body lines to display
  1. ; ^TMP($J,"IBTRH5IX") - Index of Event IENs by display line
  1. N DA,ECTR,LINE,S1,S2,S3,XSELCNT,XDA1
  1. D SORT1 ; Build the sorted list of lines to display
  1. S (ECTR,VALMCNT)=0,S1=""
  1. F S S1=$O(^TMP($J,"IBTRH5S",S1)) Q:S1="" D
  1. .S S2="" F S S2=$O(^TMP($J,"IBTRH5S",S1,S2)) Q:S2="" D
  1. .. S S3="" F S S3=$O(^TMP($J,"IBTRH5S",S1,S2,S3)) Q:S3="" D
  1. ... S DA="" F S DA=$O(^TMP($J,"IBTRH5S",S1,S2,S3,DA)) Q:DA="" D
  1. .... S ECTR=ECTR+1
  1. .... S LINE=^TMP($J,"IBTRH5S",S1,S2,S3,DA)
  1. .... S LINE=$$BLDLN(ECTR,LINE)
  1. .... S VALMCNT=VALMCNT+1,XSELCNT=$G(XSELCNT)+1
  1. .... D SET^VALM10(VALMCNT,LINE,XSELCNT)
  1. .... S ^TMP($J,"IBTRH5IX",XSELCNT)=DA
  1. .... S XDA1=$G(^IBT(356.22,DA,103))
  1. .... I $P(XDA1,"^",3)'="" D
  1. ..... N XREVDA1
  1. ..... D GETS^DIQ(356.021,$P(XDA1,"^",3),".01:.02",,"XREVDA1")
  1. ..... S VALMCNT=VALMCNT+1
  1. ..... D SET^VALM10(VALMCNT," Review Decision: "_XREVDA1(356.021,$P(XDA1,"^",3)_",",".01")_" - "_XREVDA1(356.021,$P(XDA1,"^",3)_",",".02"),XSELCNT)
  1. I VALMCNT=0 D
  1. . S ^TMP("IBTRH5",$J,1,0)="There are no events to display."
  1. Q
  1. ;
  1. BLDLN(ECTR,LINED) ; Builds a line to display on List screen for one event
  1. ; Input: ECTR - Event counter
  1. ; LINED - A1^A2^...A9 Where:
  1. ; A1 - Patient Name
  1. ; A2 - Patient Status ('I' or 'O')
  1. ; A3 - External Appt or Admission date
  1. ; A4 - Clinic or Ward name
  1. ; A5 - COB ('P', 'S' or 'T')
  1. ; A6 - Insurance Company Name
  1. ; A7 - Certification Action Code
  1. ; Output: LINE - Formatted for setting into the list display
  1. N LINE
  1. S LINE=$$SETSTR^VALM1(ECTR,"",1,4) ; Event #
  1. S LINE=$$SETSTR^VALM1($P(LINED,"^",1),LINE,6,23) ; Patient Name
  1. S LINE=$$SETSTR^VALM1($P(LINED,"^",2),LINE,30,1) ; Patient Status
  1. S LINE=$$SETSTR^VALM1($P(LINED,"^",3),LINE,32,8) ; Appt/Adm Date
  1. S LINE=$$SETSTR^VALM1($P(LINED,"^",4),LINE,41,10) ; Clinic or Ward
  1. S LINE=$$SETSTR^VALM1($P(LINED,"^",5),LINE,52,1) ; COB
  1. S LINE=$$SETSTR^VALM1($P(LINED,"^",6),LINE,55,14) ; Insurance Name
  1. S LINE=$$SETSTR^VALM1($P(LINED,"^",7),LINE,70,5) ; Certification Action Code
  1. Q LINE
  1. ;
  1. HELP ;EP
  1. ; Display HCSR Response worklist Help
  1. ; Input: None
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. W @IOF,"Flags displayed on screen for S (Patient Status):"
  1. W !," O - Outpatient"
  1. W !," I - Inpatient"
  1. W !!,"Flags displayed on screen for COB:"
  1. W !," P - Primary Insurance"
  1. W !," S - Secondary Insurance"
  1. W !," T - Tertiary"
  1. W !!,"Flags displayed for Cert Type (Certification Action):"
  1. W !," A1 - Certified in Total"
  1. W !," A2 - Certified in Partial"
  1. W !," A3 - Not Certified"
  1. W !," A6 - Modified "
  1. W !," C - Cancelled"
  1. W !," CT - Contact Payer"
  1. W !," NA - No Action Required"
  1. W !," 51 - Complete"
  1. W !," 71 - Term Expired"
  1. W !,"The following Status indicator may appear to the left of the patient name:"
  1. W !," # - 278 has been not been initiated, entry is in-progress"
  1. D PAUSE^VALM1
  1. Q
  1. ;
  1. DEL ;EP
  1. ; Protocol Action to select an entry to be manually removed from the
  1. ; Response Worklist
  1. ; Input: ^TMP("IBTRH5",$J) - Current Array of displayed entries
  1. ; ^TMP($J,"IBTRH5IX") - Current Index of displayed entries
  1. ; Output: Selected Entry is removed from the worklist
  1. ; Error messages display (potentially)
  1. ; ^TMP("IBTRH5",$J) - Updated Array of displayed entries
  1. ; ^TMP($J,"IBTRH5IX") - Updated Index of displayed entries
  1. N DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,EIEN,EIENS,ERROR,IEN,IX,LINE,MSG
  1. N PROMPT,SDATA,DELRCODE,XCOM,COM,DIWETXT
  1. S VALMBCK="R",ERROR=0
  1. S VALMSG="#In-Prog"
  1. ; First select the entry(s) to be removed from the worklist
  1. S PROMPT="Select the worklist entry(s) to be deleted"
  1. S MSG="Are you sure you want to delete "
  1. ; Select the entry to be deleted
  1. S EIENS=$$SELEVENT^IBTRH1(1,PROMPT,.DLINE,1,"IBTRH5IX")
  1. I EIENS="" S VALMBCK="R" Q
  1. ;; 1/19/16 comment out delete reason code entry
  1. ;; enter a delete reason code
  1. D1 ;;
  1. ;;S DIC(0)="AEQM",DIC="^IBT(356.023,"
  1. ;;S DIC("A")="Select a Delete Reason Code: "
  1. ;;D ^DIC
  1. ;;I Y<0 Q:X="^" W !,*7,">>>> A Delete Reason Code must be selected, or '^' to exit." G D1
  1. ;;S DELRCODE=$P(Y,"^")
  1. ;; 1/19/16 commented out code above to enter delete reason code
  1. ;
  1. Q:'$$ASKSURE^IBTRH1(DLINE,MSG) ; Final warning
  1. F IX=1:1:$L(EIENS,",") D
  1. . S EIEN=$P(EIENS,",",IX)
  1. . S LINE=$P(DLINE,",",IX)
  1. . ; Next update the status to be manually removed
  1. . I '$$LOCKEV^IBTRH1(EIEN) D Q
  1. . . W !,*7,">>>> Someone else is editing entry ",LINE,". Try again later."
  1. . . S ERROR=1
  1. . K SDATA
  1. . S IEN=EIEN_","
  1. . S SDATA(356.22,IEN,.22)=1 ; Set Response manual remove flag
  1. . S SDATA(356.22,IEN,.23)=$$NOW^XLFDT() ; Set Manually Removed Date/Time
  1. . S SDATA(356.22,IEN,.24)=DUZ ; Set Manually Removed By User
  1. . ;;S SDATA(356.22,IEN,.25)=DELRCODE ; Set Delete Reason code pointer
  1. . I $P(^IBT(356.22,EIEN,0),"^",11)="" S SDATA(356.22,IEN,.11)=DUZ ; 517-T14: if REQUESTED BY is blank, set it to user deleting
  1. . D FILE^DIE("","SDATA")
  1. . D UNLOCKEV^IBTRH1(EIEN)
  1. K DIR
  1. Q
  1. ;
  1. EXIT ;EP
  1. ; Exit the HCSR Response worklist
  1. ; Input: None
  1. K ^TMP("IBTRH5",$J),^TMP($J,"IBTRH5IX"),^TMP($J,"IBTRH5S")
  1. K HCSRSRTR
  1. D CLEAR^VALM1
  1. Q
  1. ;
  1. SORT(NOIOF) ;EP
  1. ; Listman Protocol Action to sort the worklist
  1. ; Input: NOIOF - 1 to not write @IOF, 0 otherwise
  1. ; Optional, defaults to 0
  1. ; HCSRSRTR - Current sort selection
  1. ; Output: HCSRSRTR - New sort selection
  1. N CTR,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,XX,Y
  1. S:'$D(NOIOF) NOIOF=0
  1. D FULL^VALM1
  1. S CTR=1
  1. W:'NOIOF @IOF
  1. W !,"Select the item to sort the records on the HCSR Response Worklist screen."
  1. S XX="SO^"_CTR_":Oldest Entries First",CTR=CTR+1
  1. S XX=XX_";"_CTR_":Newest Entries First",CTR=CTR+1
  1. S:+IBFILTSR(0)=2 XX=XX_";"_CTR_":Outpatient Appointments First",CTR=CTR+1
  1. S:+IBFILTSR(0)=2 XX=XX_";"_CTR_":Inpatient Admissions First",CTR=CTR+1
  1. S XX=XX_";"_CTR_":Insurance Company Name",CTR=CTR+1
  1. S XX=XX_";"_CTR_":Certification Type"
  1. S DIR(0)=XX
  1. S DIR("A")="Sort the list by",DIR("B")=$P($G(HCSRSRTR),"^",2)
  1. D ^DIR K DIR
  1. I 'Y S VALMBCK="R" Q ; User quit or timed out
  1. S HCSRSRTR=Y_"^"_Y(0) ; Sort selection
  1. ; Rebuild and resort the list and update the list header
  1. D INIT,HDR
  1. S VALMBCK="R",VALMBG=1
  1. Q
  1. ;
  1. SORT1 ; Builds the sorted list of HCSR Responses to be displayed
  1. ; Input: HCSRSRTR - Current sort selection
  1. ; Output: ^TMP("IBTRH5S",$J) - Sorted Event entries to display
  1. ;
  1. N CSTAT,DISPDT,ECTR,EIEN,EVDT,EVENT,XX
  1. K ^TMP($J,"IBTRH5S")
  1. S XX=$P(^IBE(350.9,1,62),"^",12)*-1 ; # of days to display
  1. S CSTAT=5 ; Event status for responses
  1. S DISPDT=$$FMADD^XLFDT(DT,XX)
  1. S EVDT=DISPDT,ECTR=0
  1. F D Q:EVDT=""
  1. . S EVDT=$O(^IBT(356.22,"AD",CSTAT,EVDT))
  1. . Q:EVDT=""
  1. . S EIEN=""
  1. . F D Q:EIEN=""
  1. .. S EIEN=$O(^IBT(356.22,"AD",CSTAT,EVDT,EIEN))
  1. .. Q:EIEN=""
  1. .. S EVENT=$G(^IBT(356.22,EIEN,0))
  1. .. Q:$P(EVENT,"^",13)="" ; Not a Response entry - skip
  1. .. Q:$P(EVENT,"^",22)=1 ; Manually Removed - skip
  1. .. Q:$$SKIP(EIEN,EVENT) ; Entry is filtered out
  1. .. S ECTR=ECTR+1
  1. .. I '$D(ZTQUEUED),'(ECTR#15) W "."
  1. .. D ONEEVENT(CSTAT,EIEN,EVENT) ; Add one event to sort array
  1. Q
  1. ;
  1. SKIP(EIEN,EVENT) ; Checks to see if the specified event entry should display on
  1. ; the list
  1. ; Input: EIEN - IEN of the Event entry
  1. ; EVENT - Node0 of the Event Entry being checked
  1. ; IBFILTSR() - Array of filter settings. See FILTERS for a
  1. ; detailed explanation of the FILTERS array
  1. ; Returns: 1 - Don't display the entry on the list, 0 - Display entry on list
  1. N IEN,IORO,SKIP,TRICARE,NOW,XX,ZZ
  1. S IORO=$P(EVENT,"^",4) ; 'I' Inpatient, 'O' Outpatient
  1. S NOW=$$DT^XLFDT() ; Today's Internal Fileman date
  1. I IORO="I",$P(IBFILTSR(0),"^",1)=0 Q 1 ; Only show outpatients, skip
  1. I IORO="O",$P(IBFILTSR(0),"^",1)=1 Q 1 ; Only show inpatients, skip
  1. S TRICARE=$$TRICARE^IBTRH1A(EVENT) ; Is event for Tricare?
  1. I $P(IBFILTSR(0),"^",2)=0,TRICARE Q 1 ; Only show CPAC, Skip
  1. I $P(IBFILTSR(0),"^",2)=1,'TRICARE Q 1 ; Only show Champ/Tricare, Skip
  1. S SKIP=0
  1. ; Check Division filter
  1. I $D(IBFILTSR(3)) D Q:SKIP 1
  1. . S XX="^"_IBFILTSR(3)_"^",Y=1
  1. . S IEN=$P(EVENT,"^",5) ; Ward IEN
  1. . S:IEN="" IEN=$P(EVENT,"^",6),Y=0 ; Clinic IEN
  1. . I Y S ZZ=$$GET1^DIQ(42,IEN_",",.015,"I")
  1. . E S ZZ=$$GET1^DIQ(44,IEN_",",3.5,"I")
  1. . S ZZ="^"_ZZ_"^"
  1. . I XX'[ZZ S SKIP=1 ; Wrong division
  1. ; Check Inpatient entry
  1. I IORO="I" D Q:SKIP 1
  1. . Q:$G(IBFILTSR(2))="" ; No Ward filters display
  1. . S IEN=$P(EVENT,"^",5) ; Ward IEN
  1. . S XX="^"_IBFILTSR(2)_"^"
  1. . Q:XX[("^"_IEN_"^") ; On inclusion list display
  1. . S SKIP=1 ; Not on inclusion list skip
  1. ; Check Outpatient entry
  1. I IORO="O" D Q:SKIP 1
  1. . Q:$G(IBFILTSR(1))="" ; No Clinic filters display
  1. . S IEN=$P(EVENT,"^",6) ; Clinic IEN
  1. . S XX="^"_IBFILTSR(1)_"^"
  1. . Q:XX[("^"_IEN_"^") ; On inclusion list display
  1. . S SKIP=1
  1. Q 0 ; Display this entry
  1. ;
  1. ONEEVENT(CSTAT,EIEN,EVENT) ; Adds one event to the sorted list
  1. ; Input: HCSRSORT - Current sort selection
  1. ; CSTAT - Status of the event to be added
  1. ; EIEN - Internal IEN of the event being added
  1. ; EVENT - ^IBT(356.22,EIEN,0)
  1. ; Output: ^TMP("IBTRH5S",$J) - Sorted Event entries to display
  1. N ADATE,CERTCDE,DFN,ESTATUS,HS1,HS2,HS3,ICOB,IENS,IGROUP,IIEN,INAME,ISTATUS
  1. N LINE,PNAME,RFLG,IMIEN
  1. S (INAME,LINE)=""
  1. ; Symbol to display in front of the patient name (if any)
  1. S RFLG=$S($$GET1^DIQ(356.22,EIEN_",",.21,"I")=1:"#",1:" ")
  1. S DFN=$P(EVENT,"^",2),PNAME="" ; Patient IEN
  1. S ESTATUS=$P(EVENT,"^",4) ; Patient Status
  1. S $P(LINE,"^",2)=ESTATUS
  1. S ADATE=$P(EVENT,"^",7) ; Internal Appt/Adm Date/Tm
  1. S $P(LINE,"^",3)=$$FMTE^XLFDT(ADATE,"2DZ")
  1. S ISTATUS=1
  1. I ESTATUS="O",+HCSRSRTR=3 S ISTATUS=0 ; Appointment sort
  1. I ESTATUS="I",+HCSRSRTR=4 S ISTATUS=0 ; Admissions sort
  1. S $P(LINE,"^",1)=$$PNAME^IBTRH1A(DFN,RFLG,.PNAME) ; Set 'PAT NAME' column
  1. S $P(LINE,"^",4)=$$PATLOC^IBTRH1A(EVENT) ; Ward or Clinic
  1. S IMIEN=$P(EVENT,"^",3),IENS=IMIEN_","_DFN_"," ; Insurance Multiple IEN
  1. S IIEN=$$GET1^DIQ(2.312,IENS,.01,"I") ; Insurance Company IEN
  1. S IGROUP=$$GET1^DIQ(2.312,IENS,.18,"I") ; Insurance Group IEN
  1. S:+IIEN INAME=$$GET1^DIQ(36,IIEN_",",.01) ; Insurance Company Name
  1. S:INAME="" INAME="**DELETED**"
  1. S ICOB=$$GET1^DIQ(2.312,IENS,.2,"I") ; Level of COB External Display
  1. S:ICOB="" ICOB=1
  1. S $P(LINE,"^",5)=$S(ICOB=1:"P",ICOB=2:"S",1:"T") ; Level of COB External Display
  1. S CERTCDE=$$GET1^DIQ(356.22,EIEN_",",103.01)
  1. S $P(LINE,"^",6)=$E(INAME,1,14)
  1. I +HCSRSRTR=1 S HS1=ADATE,HS2=PNAME,HS3=ICOB ; Oldest event first
  1. I +HCSRSRTR=2 S HS1=ADATE*-1,HS2=PNAME,HS3=ICOB ; Newest event first
  1. I +HCSRSRTR=3 S HS1=ISTATUS,HS2=PNAME,HS3=ICOB ; Appointments first
  1. I +HCSRSRTR=4 S HS1=ISTATUS,HS2=PNAME,HS3=ICOB ; Admissions sort
  1. I +HCSRSRTR=5 D ; Insurance name sort
  1. . S HS1=$$UP^XLFSTR(INAME),HS2=PNAME,HS3=ICOB
  1. I +HCSRSRTR=6 S HS1=CERTCDE,HS2=PNAME,HS3=ADATE ; Certification Action sort
  1. S $P(LINE,"^",7)=CERTCDE
  1. S ^TMP($J,"IBTRH5S",HS1,HS2,HS3,EIEN)=LINE
  1. Q
  1. ;
  1. SELEVENT(FULL,PROMPT,DLINE) ;EP
  1. ; Select an Event to perform an action upon
  1. ; upon
  1. ; Input: FULL - 1 - full screen mode, 0 otherwise
  1. ; PROMPT - Prompt to be displayed to the user
  1. ; ^TMP("IBTRH5",$J) - Array of displayed events
  1. ; ^TMP($J,"IBTRH5IX") - Index of displayed lines
  1. ; Output: DLINE - Line # of the selected event
  1. ; Returns: EIN - IEN of the selected event or
  1. ; 0 if none selected
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,EIEN,X,Y
  1. D:FULL FULL^VALM1
  1. S DLINE=$P($P($G(XQORNOD(0)),"^",4),"=",2) ; User selection with action
  1. I $D(^TMP($J,"IBTRH5IX",+DLINE)) D Q EIEN
  1. . S EIEN=^TMP($J,"IBTRH5IX",DLINE)
  1. S DIR(0)="NO^"_VALMBG_":"_VALMLST_":0" ; Select an event from screen
  1. S DIR("A")=PROMPT
  1. D ^DIR K DIR
  1. Q:'Y 0
  1. S DLINE=Y,EIEN=^TMP($J,"IBTRH5IX",DLINE)
  1. Q EIEN
  1. ;
  1. REFRESH ;EP
  1. ; Protocol action to search for new Responses, reset filter
  1. ; and redisplay the HCSR Response Worklist
  1. ; Input: HCSSORTR - Current sort selection
  1. ; Output: IBFILTSR() - Array of filter criteria
  1. ; NOTE: Any modifications done to these filters
  1. ; are not returned back to HCSR Worklist.
  1. ; ^TMP("IBTRH5",$J) - Body lines to display
  1. ; ^TMP($J,"IBTRH5S") - Sorted Body lines to display
  1. ; ^TMP($J,"IBTRH5IX") - Index of Event IENs by display line
  1. ;
  1. ; First check to see if we can create more event entries
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. Q:'$$FILTERS^IBTRH1A(.IBFILTSR) ; Reset Filter criteria
  1. D SORT(1)
  1. ;;3/21/16 JWS don't need to D HDR,INIT - already done in SORT(1) above
  1. ;D HDR ; Redisplay the header
  1. ;D INIT ; Rebuild the worklist
  1. Q
  1. ;
  1. SEND278(EIEN) ;EP
  1. ; Protocol action to create a new 278 request from a response. Copies the
  1. ; Request data from the response's original request and then allows the
  1. ; user to edit it before sending the request
  1. ; Input: EIEN - IEN of the Response Entry to create a new worklist
  1. ; entry from. Optional, only set when called from
  1. ; Protocol IBT HCSR RESPONSE EE SEND278 - SR from
  1. ; the EE action off of the Response Worklist.
  1. N DLINE,IBTRENT,IBTRIEN,PROMPT,REIEN,SEIEN,IBRESP
  1. S SEIEN=$S($D(EIEN):EIEN,1:"")
  1. ;
  1. ; First select the entry to create a request for from the worklist
  1. S PROMPT="Select the worklist entry"
  1. S:SEIEN="" SEIEN=$$SELEVENT^IBTRH1(1,PROMPT,.DLINE,0,"IBTRH5IX")
  1. I SEIEN="" S VALMBCK="R" Q
  1. ; do not allow multiple 278s to be created from the same response
  1. I $P(^IBT(356.22,SEIEN,0),"^",27) D Q
  1. . W !,*7,">>>> A 278 request has already been created from this response message."
  1. . D PAUSE^VALM1
  1. ;
  1. ; Next Lock the response entry
  1. I '$$LOCKEV^IBTRH1(SEIEN) D Q
  1. . W !,*7,">>>> Someone else is editing this entry. Try again later."
  1. . D PAUSE^VALM1
  1. ; Copy the request
  1. S REIEN=$P(^IBT(356.22,SEIEN,0),"^",13) ; Original Request entry
  1. S IBTRIEN=$$CRTENTRY^IBTRH5C(REIEN,SEIEN,"","",1) ; Copy the original request
  1. D UNLOCKEV^IBTRH1(SEIEN) ; Unlock the response entry
  1. Q:IBTRIEN=0 ; Copy was unsuccessful
  1. ; Next Lock the new request entry
  1. I '$$LOCKEV^IBTRH1(IBTRIEN) D Q
  1. . W !,*7,">>>> Someone else is editing entry. Try again later."
  1. . D PAUSE^VALM1
  1. S IBTRENT=2 ; Flag to indicate origin from here
  1. D SEND278^IBTRH2 ; Create and Send the request
  1. D UNLOCKEV^IBTRH1(IBTRIEN) ; Unlock the request entry
  1. W !,"A new HCSR Worklist entry has been created for Response."
  1. D PAUSE^VALM1
  1. Q
  1. ;
  1. DELAY ;EP
  1. ; Protocol action to create a new request from the response but delay its
  1. ; viewing on the HCSR Worklist until admission of the entry has been
  1. ; discharged.
  1. ; Input: ^TMP("IBTRH5",$J) - Current Array of displayed entries
  1. ; ^TMP($J,"IBTRH5IX") - Current Index of displayed entries
  1. ; Output: A new Request is created from the Selected Entry (potentially)
  1. N DDATE,DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,EIEN,EIENS,FIELD,GOOD
  1. N IX,LINE,MSG,PROMPT,REIEN,SDATA
  1. S VALMBCK="R",GOOD=0
  1. S MSG="Are you sure you want to delay "
  1. S PROMPT="Select the worklist entry(s) to be delayed"
  1. ; First select the entry(s) to be delay review from the worklist
  1. S EIENS=$$SELEVENT^IBTRH1(1,PROMPT,.DLINE,1,"IBTRH5IX")
  1. I EIENS="" S VALMBCK="R" Q
  1. S DDATE=$$GETDDATE^IBTRH1B(DLINE) ; Get delay date
  1. Q:DDATE=""
  1. S MSG=MSG_$S(DLINE[",":"Entries ",1:"Entry ")_DLINE_" until "
  1. S MSG=MSG_$S(DDATE="D":"Discharge",1:$$FMTE^XLFDT(DDATE,"2Z"))
  1. Q:'$$ASKSURE^IBTRH1(DLINE,MSG,1) ; Final warning
  1. F IX=1:1:$L(EIENS,",") D
  1. . S EIEN=$P(EIENS,",",IX)
  1. . S LINE=$P(DLINE,",",IX)
  1. . ; do not allow multiple 278s to be created from the same response
  1. . I $P(^IBT(356.22,EIEN,0),"^",27) D Q
  1. .. W !,*7,">>>> A 278 request has already been created from this response message."
  1. . ; Only allow delay of events for Inpatients
  1. . I $P(^IBT(356.22,EIEN,0),"^",4)="O" D Q
  1. .. W !,*7,">>>> Entry ",LINE," is for an Outpatient and cannot be delayed"
  1. . ; Next set the delay date of the entry
  1. . I '$$LOCKEV^IBTRH1(EIEN) D Q
  1. .. W !,*7,">>>> Someone else is editing entry ",LINE,". Try again later."
  1. . ; Copy the request
  1. . S GOOD=1
  1. . S REIEN=$P(^IBT(356.22,EIEN,0),"^",13) ; Original Request entry
  1. . S IBTRIEN=$$CRTENTRY^IBTRH5C(EIEN,REIEN,"","",1,DDATE) ; Copy original request
  1. . D UNLOCKEV^IBTRH1(EIEN)
  1. K DIR
  1. I GOOD D
  1. . W !!,$S(DLINE[",":"Entries ",1:"Entry ")_DLINE
  1. . W $S(DLINE[",":" have_",1:" has ")_"been delayed"
  1. D PAUSE^VALM1
  1. Q
  1. ;