IBTRH1A ;ALB/FA - HCSR Worklist ;12-AUG-2014
;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
;;Per VA Directive 6402, this routine should not be modified.
;;
;
; Contains Entry points and functions used in filtering/displaying the
; HCSR Worklist
;
; -------------------------- Entry Points --------------------------------
; FILTERS - Used to set filtering criteria for what entries should be
; displayed in the worklist
; PATLOC - Formats the Clinic or Ward name for display on the HCSR
; Worklist and the HCSR Response Worklist
; PNAME - Formats the patient name for display on the HCSR Worklist
; and the HCSR Response Worklist
; REFRESH - Protocol action that allows the user to check for recent
; appointments and admissions, re-select filter options and
; redisplays the HCSR Worklist
; SORT1 - Used to sort the entries in the worklist per user selected
; option
;-----------------------------------------------------------------------------
;
REFRESH ;EP
; Protocol action to search for new appointments/admission, reset filter
; and redisplay the HCSR Worklist
; Input: HCSSORT - Current sort selection
; Output: IBFILTS() - Array of filter criteria
; ^TMP("IBTRH1",$J) - Body lines to display
; ^TMP($J,"IBTRH1S") - Sorted Body lines to display
; ^TMP($J,"IBTRH1IX") - Index of Event IENs by display line
;
; First check to see if we can create more event entries
;;D EN^IBTRHDE(1) ;JWS 3/21/16 - remove this. don't want to create more entries this way
D VALMSGH^IBTRH1 ; Set flag legend
D FULL^VALM1
S VALMBCK="R"
Q:'$$FILTERS(.IBFILTS) ; Reset Filter criteria
D CLEAN^VALM10
S VALMBG=1
D SORT^IBTRH1(2) ; Sort the entries
D INIT^IBTRH1 ; Rebuild the worklist
D HDR^IBTRH1 ; Redisplay the header
Q
;
FILTERS(FILTERS) ;EP
; Sets an array of filters to determine which entries in HCSR Transmission
; file should be displayed to the user
; Input: None
; Output: FILTERS(0) - A1^A2 Where:
; A1 - 0 - 'Output' entries only
; 1 - 'Input' entries only
; 2 - Both Output and Input entries
; A2 - O - CPAC entries only
; 1 - Champva/Tricare entries only
; 2 - Both CPAC and Champva/Tricare entries
; A3 - 0 - No Division filter
; 1 - Selected Division filter
; FILTERS(1) - '^' delimited list of included Clinic IENs
; Null if all clinics are included
; Only set if FILTERS(0)= 0 OR 2
; FILTERS(2) - '^' delimited list of included WARD IENs
; Null if all wards are included
; Only set if FILTERS(0)= 1 OR 2
; FILTERS(3) - '^' delimited list of included Division IENs
; Null if all Divisions are included
; Returns: 0 if the user entered '^' or timed out, 1 otherwise
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,XX,Y
K FILTERS
;
; ChampVA/Tricare filter
S DIR(0)="S",DIR("A")="Show CHAMPVA/TRICARE entries, CPAC entries or Both",DIR("B")="B"
S DIR("?",1)="Enter 'T' to only view entries created for CHAMPVA/TRICARE"
S DIR("?",2)="Enter 'C' to only view entries created for CPAC"
S DIR("?")="Enter 'B' to view entries both CHAMPVA/TRICARE and CPAC entries"
S $P(DIR(0),"^",2)="T:CHAMPVA/TRICARE;C:CPAC;B:Both"
W !! D ^DIR K DIR
I $G(DIRUT) Q 0
;
; Inpatient/Outpatient filter
S X=$$UP^XLFSTR(X)
S $P(FILTERS(0),"^",2)=$S(X="C":0,X="T":1,1:2)
S DIR(0)="S",DIR("A")="Show Inpatient entries, Outpatient entries or Both",DIR("B")="B"
S DIR("?",1)="Enter 'I' to only view entries created for inpatients"
S DIR("?",2)="Enter 'O' to only view entries created for outpatients"
S DIR("?")="Enter 'B' to view entries both inpatient and outpatient entries"
S $P(DIR(0),"^",2)="O:Outpatient;I:Inpatient;B:Both"
W ! D ^DIR K DIR
I $G(DIRUT) Q 0
S X=$$UP^XLFSTR(X)
S $P(FILTERS(0),"^",1)=$S(X="O":0,X="I":1,1:2)
;
; Division filter
S X=$$UP^XLFSTR(X)
S $P(FILTERS(0),"^",3)=$S(X="A":0,1:1)
S DIR(0)="S",DIR("A")="Select(A)ll or (S)elected Divisions",DIR("B")="All"
S DIR("?",1)="Enter 'A' to not filter by division."
S DIR("?")="Enter 'S' to view entries for selected division(s)."
S $P(DIR(0),"^",2)="A:All;S:Selected"
W ! D ^DIR K DIR
I $G(DIRUT) Q 0
S X=$$UP^XLFSTR(X)
S $P(FILTERS(0),"^",3)=$S(Y="A":0,1:1)
;
; Set Division inclusion filter
I $P(FILTERS(0),"^",3)=1 D ASKDIV(.FILTERS)
;
; Set Ward inclusion filter
I $P(FILTERS(0),"^",1)>0 D ASKWORC(0,.FILTERS)
;
; Set Clinic inclusion filter
I ($P(FILTERS(0),"^",1)=0)!($P(FILTERS(0),"^",1)=2) D ASKWORC(1,.FILTERS)
;
; If any Division, Clinic or Ward inclusion filters were set, display the final results
I ($G(FILTERS(1))'="")!($G(FILTERS(2))'="")!($G(FILTERS(3))'="") D
. D SHOWFILT^IBTRH1B(.FILTERS)
Q 1
;
ASKDIV(FILTERS) ; Sets a list of Division to be displayed in the HSCR Worklist
; Input: FILTERS - Current Array of filter settings
; Output: FILTERS - Updated Array of filter settings
N DIC,DIR,DIRUT,DIVS,DUOUT,FIRST,IBIENS,IBIENS2,IEN,N,X,XX,Y
S DIC=40.8,DIC(0)="AE",FIRST=1
F D Q:+IEN<1
. D ONEDIV(.DIC,.IEN,.FIRST) ; One Division prompt
. Q:+IEN<1
. S IBIENS($P(IEN,"^",2))=$P(IEN,"^",1)
. S IBIENS2($P(IEN,"^",1))=$P(IEN,"^",2)
I '$D(IBIENS) S $P(FILTERS(0),"^",3)=0 Q
;
; Set the filter node responses in alphabetical order
S XX=""
F D Q:XX=""
. S XX=$O(IBIENS(XX))
. Q:XX=""
. S N=IBIENS(XX)
. S FILTERS(3)=$S($G(FILTERS(3))'="":FILTERS(3)_"^"_N,1:N)
Q
;
ONEDIV(DIC,IEN,FIRST) ; Prompts the user for a division
; Input: DIC - Variable/Array of settings needed for ^DIC call
; FIRST - Set to 1 initially and then 0 for subsequent calls
; Output: FIRST - Set to 0
; IEN - IEN of the selected Division
; null of no selection was made
S DIC("A")=$S(FIRST:"Select a Division: ",1:"Select Another Division: ")
D ^DIC
S FIRST=0,IEN=Y
Q
;
ASKWORC(WHICH,FILTERS) ; Sets a list of wards or clinics to be displayed in
; the HCSR Worklist
; Input: WHICH - 0 Ward selection, 1 - Clinic Selection
; FILTERS - Current Array of filter settings
; Output: FILTERS - Updated Array of filter settings
N CLINS,DIC,DIR,DIRUT,DIVS,DUOUT,FIRST,IBIENS,IBIENS2,IEN,N,NM,NODE,WARDS,X,XX,Y
S DIC=$S(WHICH=0:42,1:44),DIC(0)="AE",FIRST=1
S NODE=$S(WHICH=0:2,1:1)
F N=1:1:$L($G(FILTERS(3)),"^") D
. S XX=$P($G(FILTERS(3)),"^",N)
. Q:XX=""
. S DIVS(XX)=""
;
I WHICH=0 D
. S N=0,NM="Ward"
. F D Q:+N=0
. . S N=$O(^IBE(350.9,1,64,N))
. . Q:+N=0
. . S IEN=$P(^IBE(350.9,1,64,N,0),"^",1)
. . S WARDS(IEN)=""
. I $D(WARDS)!$D(FILTERS(3)) D
. . S DIC("S")="I $$WCFILT^IBTRH1A(1,Y,.DIVS,"""",.WARDS)"
I WHICH=1 D
. S N=0,NM="Clinic"
. F D Q:+N=0
. . S N=$O(^IBE(350.9,1,63,N))
. . Q:+N=0
. . S IEN=$P(^IBE(350.9,1,63,N,0),"^",1)
. . S CLINS(IEN)=""
. I $D(CLINS)!$D(FILTERS(3)) D
. . S DIC("S")="I $$WCFILT^IBTRH1A(0,Y,.DIVS,.CLINS,"""")"
F D Q:+IEN<1
. D ONEWORC(.DIC,NM,.IEN,.FIRST) ; One Clinic or Ward prompt
. Q:+IEN<1
. S IBIENS($P(IEN,"^",2))=$P(IEN,"^",1)
. S IBIENS2($P(IEN,"^",1))=$P(IEN,"^",2)
I '$D(IBIENS) S FILTERS(NODE)="" Q
;
; Set the filter node responses in alphabetical order
S XX=""
F D Q:XX=""
. S XX=$O(IBIENS(XX))
. Q:XX=""
. S N=IBIENS(XX)
. S FILTERS(NODE)=$S($G(FILTERS(NODE))'="":FILTERS(NODE)_"^"_N,1:N)
Q
;
ONEWORC(DIC,WHICH,IEN,FIRST) ; Prompts the user for a clinic or ward
; Input: DIC - Variable/Array of settings needed for ^DIC call
; WHICH - 'Ward' or 'Clinic'
; FIRST - Set to 1 initially and then 0 for subsequent calls
; Output: FIRST - Set to 0
; IEN - IEN of the selected Ward or clinic Entry
; null of no selection was made
S DIC("A")=$S(FIRST:"Select "_WHICH_": ",1:"Select Another "_WHICH_": ")
D ^DIC
S FIRST=0,IEN=Y
Q
;
WCFILT(WHICH,IEN,DIVS,CLINS,WARDS) ; Used as a dictionary screen when doing
; Clinic or Ward inclusion filter lookups.
; Input: WHICH - 0 - Clinic Lookup
; 1 - Ward lookup
; IEN - IEN of the Clinic or Ward being looked up
; DIVS - Array of Included Divisions (if any)
; CLINS - Array of Site Parameter included Clinics (if any)
; WARDS - Array of Site Parameter included Wards (if any)
; Returns: 1 - Clinic or Ward is valid, 0 otherwise
N IDIVS,RETURN,SDIV
S IDIVS=$S($O(DIVS(""))'="":1,1:0)
S RETURN=1
;
; Clinic filter check
I WHICH=0 D Q RETURN
. I $D(CLINS),'$D(CLINS(IEN)) S RETURN=0 Q ; Not on Site param inc list
. ;
. ; If we have included divisions make sure clinic is for the division
. I IDIVS D Q
. . S SDIV=$$GET1^DIQ(44,IEN_",",3.5,"I") ; Division of the Clinic
. . Q:SDIV=""
. . S:'$D(DIVS(SDIV)) RETURN=0 ; Division not in list
;
; Ward filter check
I $D(WARDS),'$D(WARDS(IEN)) Q 0 ; On Site param exclusion list
;
; If we have included divisions make sure ward is for the division
I IDIVS D
. S SDIV=$$GET1^DIQ(42,IEN_",",.015,"I") ; Division of the Ward
. Q:SDIV=""
. S:'$D(DIVS(SDIV)) RETURN=0 ; Division not in list
Q RETURN
;
SORT1 ;EP
; Builds the sorted list of HCSR entries to be displayed on the HCSR Worklist
; Input: HCSRSORT - Current sort selection
; IBFILTS() - Array of filter settings. See FILTERS for a
; detailed explanation of the FILTERS array
; Output: ^TMP("IBTRH1S",$J) - Sorted Event Entries to display
;
N DFN,CSTAT,ECTR,EIEN,EVDT,EVENT
K ^TMP($J,"IBTRH1S")
S ECTR=0
;
; Loop through all the statuses that are shown on the worklist
F CSTAT=0,1,2,3,4,7,8 D
. S EVDT=""
. F D Q:EVDT=""
. . S EVDT=$O(^IBT(356.22,"AD",CSTAT,EVDT))
. . Q:EVDT=""
. . S EIEN=""
. . F D Q:EIEN=""
. . . S EIEN=$O(^IBT(356.22,"AD",CSTAT,EVDT,EIEN))
. . . Q:EIEN=""
. . . S EVENT=$G(^IBT(356.22,EIEN,0))
. . . Q:$P(EVENT,"^",13)'="" ; Response entry - skip
. . . Q:$$SKIP(EVENT) ; Entry is filtered out
. . . S ECTR=ECTR+1
. . . I '$D(ZTQUEUED),'(ECTR#15) W "."
. . . D ONEEVENT(CSTAT,EIEN,EVENT) ; Add one event to sort array
Q
;
SKIP(EVENT) ; Checks to see if the specified event entry should display on the
; list
; Input: EVENT - Event Entry being checked
; IBFILTS() - Array of filter settings. See FILTERS for a
; detailed explanation of the FILTERS array
; Returns: 1 - Don't display the entry on the list, 0 - Display entry on list
N DELAY,IEN,IORO,SKIP,TRICARE,NOW,XX,YY,ZZ
I $P(EVENT,"^",19)=1 Q 1 ; Skip if a 215 was triggered
S IORO=$P(EVENT,"^",4) ; 'I' Inpatient, 'O' Outpatient
S NOW=$$DT^XLFDT() ; Today's Internal Fileman date
S DELAY=0
S:+$P(EVENT,"^",8)=8 DELAY=$P(EVENT,"^",17) ; Delay Date (if any)
I IORO="I",$P(IBFILTS(0),"^",1)=0 Q 1 ; Only show outpatients, skip
I IORO="O",$P(IBFILTS(0),"^",1)=1 Q 1 ; Only show inpatients, skip
S TRICARE=$$TRICARE(EVENT) ; Is event for Tricare?
I $P(IBFILTS(0),"^",2)=0,TRICARE Q 1 ; Only show CPAC, Skip
I $P(IBFILTS(0),"^",2)=1,'TRICARE Q 1 ; Only show Champ/Tricare, Skip
S SKIP=0
;
; Check Division filter
I $D(IBFILTS(3)) D Q:SKIP 1
. S XX="^"_IBFILTS(3)_"^",Y=1
. S IEN=$P(EVENT,"^",5) ; Ward IEN
. S:IEN="" IEN=$P(EVENT,"^",6),Y=0 ; Clinic IEN
. I Y S ZZ=$$GET1^DIQ(42,IEN_",",.015,"I")
. E S ZZ=$$GET1^DIQ(44,IEN_",",3.5,"I")
. S ZZ="^"_ZZ_"^"
. I XX'[ZZ S SKIP=1 ; Wrong division
;
; Check Inpatient entry
I IORO="I" D Q:SKIP 1
. Q:$G(IBFILTS(2))="" ; No Ward filters display
. S IEN=$P(EVENT,"^",5) ; Ward IEN
. S XX="^"_IBFILTS(2)_"^"
. Q:XX[("^"_IEN_"^") ; On inclusion list display
. S SKIP=1 ; Not on inclusion list skip
;
; Check Outpatient entry
I IORO="O" D Q:SKIP 1
. Q:$G(IBFILTS(1))="" ; No Clinic filters display
. S IEN=$P(EVENT,"^",6) ; Clinic IEN
. S XX="^"_IBFILTS(1)_"^"
. Q:XX[("^"_IEN_"^") ; On inclusion list display
. S SKIP=1
;
; Skip entries that haven't reached their delay date yet
I DELAY D Q:SKIP 1
. I DELAY'="D" D Q
. . S:DELAY>NOW SKIP=1 ; Delay date not met, skip
. S:'$$DISCH(EVENT) SKIP=1 ; Not Discharge yet, skip
Q 0 ; Display this entry
;
TRICARE(EVENT) ;EP
; Checks to see if the entry is for a ChampVA/Tricare insurance
; Input: EVENT - Node 0 of the Event Entry being checked
; Returns: 1 if the entry is for ChampVA/Tricare Insurance, 0 otherwise
N COVTYPE,DFN,IENS,IIEN,IMIEN,INSNAME,GRPLAN,GRPLANTP
S DFN=$P(EVENT,U,2) ; Patient IEN
S IMIEN=$P(EVENT,U,3),IENS=IMIEN_","_DFN_"," ; Insurance Multiple IEN
S IIEN=$$GET1^DIQ(2.312,IENS,.01,"I") ; Insurance Company IEN
S GRPLAN=$$GET1^DIQ(2.312,IENS,.18,"I") ;GROUP PLAN 355.3 PTR
S GRPLANTP=$$GET1^DIQ(355.3,GRPLAN_",",.09)
S COVTYPE=$$UP^XLFSTR($$GET1^DIQ(36,IIEN_",",.13,"E")) ; Type of Coverage (36/.13)
S INSNAME=$$UP^XLFSTR($$GET1^DIQ(36,IIEN_",",.01)) ; Insurance Company Name
S TRICARE=0
S:(COVTYPE["TRICARE")!(COVTYPE["CHAMPVA")!(INSNAME["TRICARE")!(INSNAME["CHAMPVA")!(GRPLANTP["CHAMPVA")!(GRPLANTP["TRICARE") TRICARE=1
Q TRICARE
;
DISCH(EVENT) ; Checks to see if the admission of the entry has been discharged
; Input: EVENT - Node 0 of the Event Entry being checked
; Returns: 1 if the admission has been discharged, 0 otherwise
N ADATE,DA,DFN,DT,FOUND,IADATE,REC
S DFN=$P(EVENT,"^",2) ; DFN of the patient
S ADATE=$P(EVENT,"^",7) ; Internal Admit date
I ADATE["-" Q 0 ; Admission is already discharged
S IADATE=9999999.9999999-ADATE
S DA=$O(^DGPM("ATID1",DFN,IADATE,"")) ; DBIA419
Q:DA="" -1 ; No Patient Movement admission record
I $$GET1^DIQ(405,DA_",",.17,"I")'="" Q 1 ; Patient has been discharged
Q 0 ; Admission is still active
;
ONEEVENT(CSTAT,EIEN,EVENT) ; Adds one event to the sorted list
; Input: HCSRSORT - Current sort selection
; CSTAT - Status of the event to be added
; EIEN - Internal IEN of the event being added
; EVENT - ^IBT(356.22,EIEN,0)
; Output: ^TMP("IBTRH1S",$J) - Sorted Event entries to display
N ADATE,DFN,ESTATUS,HS1,HS2,HS3,ICOB,IENS,IGROUP,IIEN,IMIEN,INAME,ISTATUS
N LINE,PCREQ,PNAME,RFLG,URREQ,XX
S (INAME,LINE,PCREQ,URREQ)=""
;
; Symbol to display in front of the patient name (if any)
S RFLG=$S(CSTAT=1:"#",CSTAT=2:"?",CSTAT=3:"!",CSTAT=4:"-",CSTAT=7:"+",CSTAT=8:"*",1:" ")
S DFN=$P(EVENT,"^",2),PNAME="" ; Patient IEN
S ESTATUS=$P(EVENT,"^",4) ; Patient Status 'I' or 'O'
S $P(LINE,"^",2)=ESTATUS
S ADATE=$P($P(EVENT,"^",7),"-",1) ; Internal Appt/Adm Date/Tm
S $P(LINE,"^",3)=$$FMTE^XLFDT(ADATE,"2DZ")
S ISTATUS=1
I ESTATUS="O",+HCSRSORT=3 S ISTATUS=0 ; Appointment sort
I ESTATUS="I",+HCSRSORT=4 S ISTATUS=0 ; Admissions sort
S $P(LINE,"^",1)=$$PNAME(DFN,RFLG,.PNAME) ; Set 'PAT NAME' column
S $P(LINE,"^",4)=$$PATLOC(EVENT) ; Ward or Clinic
S IMIEN=$P(EVENT,"^",3),IENS=IMIEN_","_DFN_"," ; Insurance Multiple IEN
S IIEN=$$GET1^DIQ(2.312,IENS,.01,"I") ; Insurance Company IEN
S IGROUP=$$GET1^DIQ(2.312,IENS,.18,"I") ; Insurance Group IEN
S:+IIEN INAME=$$GET1^DIQ(36,IIEN_",",.01) ; Insurance Company Name
S:INAME="" INAME="**DELETED**"
S ICOB=$$GET1^DIQ(2.312,IENS,.2,"I") ; Level of COB External Display
S:ICOB="" ICOB=1
S $P(LINE,"^",5)=$S(ICOB=1:"P",ICOB=2:"S",1:"T") ; Level of COB External Display
S $P(LINE,"^",6)=$E(INAME,1,14)
;
I +HCSRSORT=1 S HS1=ADATE,HS2=PNAME,HS3=ICOB ; Oldest event first
I +HCSRSORT=2 S HS1=ADATE*-1,HS2=PNAME,HS3=ICOB ; Newest event first
I +HCSRSORT=3 S HS1=ISTATUS,HS2=PNAME,HS3=ICOB ; Appointments first
I +HCSRSORT=4 S HS1=ISTATUS,HS2=PNAME,HS3=ICOB ; Admissions sort
I +HCSRSORT=5 D ; Insurance name sort
. S HS1=$$UP^XLFSTR(INAME),HS2=PNAME,HS3=ICOB
S XX=$P($G(^IBA(355.3,+IGROUP,0)),"^",6) ; Pre-Certification Req
S PCREQ=$S(XX=1:"Y",XX=0:"N",1:"")
S XX=$P($G(^IBA(355.3,+IGROUP,0)),"^",5) ; Utilization Review Req
S URREQ=$S(XX=1:"Y",XX=0:"N",1:"")
S $P(LINE,"^",7)=URREQ
S $P(LINE,"^",8)=PCREQ
S $P(LINE,"^",9)=$$GETSCR(DFN) ; Service Connected Reasons
S ^TMP($J,"IBTRH1S",HS1,HS2,HS3,EIEN)=LINE
Q
;
PNAME(DFN,RFLG,PNAME) ;EP
; Format the patient name column for display in the worklist
; Input: DFN - Internal IEN of the patient
; RFLG - Symbol to display in front of the name (if any)
; Output: PNAME - $P(^DPT(DFN,0),"^",1)
; Returns: Formatted patient name
N PNM,SSN4
Q:+DFN=0 ""
S PNAME=$$GET1^DIQ(2,DFN_",",.01) ; Patient Name
S PNM=RFLG_PNAME,PNM=$E(PNM,1,18)
S:$L(PNM)<18 PNM=PNM_$J("",18-$L(PNM))
S SSN4=$E($$GET1^DIQ(2,DFN_",",.09),6,9) ; Last 4 of SSN
Q PNM_" "_SSN4
;
PATLOC(EVENT) ;EP
; Returns the Clinic or Ward associated with the event
; Input: EVENT - ^IBT(356.22,EIEN,0)
; Returns: Formatted Clinic or location name
N ELOC
S ELOC=$P(EVENT,"^",5)
I ELOC'="" D ; Ward Name
. S ELOC=$$GET1^DIQ(42,ELOC_",",.01)
E D ; Clinic Name
. S ELOC=$P(EVENT,"^",6)
. S:ELOC'="" ELOC=$$GET1^DIQ(44,ELOC_",",.01)
Q $E(ELOC,1,10)
;
GETSCR(DFN) ; Retrieves all of the services connected reasons to be displayed
; Input: DFN - Internal IEN of the patient of the event
; Returns: SCR - String of Service Connected reasons to be displayed
N DGNTARR,SCR,VAERR,VASV,XX
S SCR=""
; DBIA #10061
D SVC^VADPT I 'VAERR D
.I VASV(2) S SCR="A" ; Agent Orange Exposure
.I VASV(3) S SCR=SCR_"I" ; Ionizing Radiation
.I VASV(1) S SCR=SCR_"S" ; Southwest Asia
.I VASV(5) S SCR=SCR_"C" ; Combat Veteran
.I $G(VASV(15)) S SCR=SCR_"L" ; Camp Lejeune
.Q
S XX=$$GETCUR^DGNTAPI(DFN,"DGNTARR") ; Nose/Throat Radium, DBIA3457
S XX=$S(XX>0:DGNTARR("INTRP"),1:"")
I +XX S SCR=SCR_"N"
S XX=$P($$GETSTAT^DGMSTAPI(DFN),"^",2) ; Military Sexual Trauma, DBIA2716
I XX="Y" S SCR=SCR_"M"
Q SCR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRH1A 19742 printed Oct 16, 2024@18:28:36 Page 2
IBTRH1A ;ALB/FA - HCSR Worklist ;12-AUG-2014
+1 ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;
+4 ;
+5 ; Contains Entry points and functions used in filtering/displaying the
+6 ; HCSR Worklist
+7 ;
+8 ; -------------------------- Entry Points --------------------------------
+9 ; FILTERS - Used to set filtering criteria for what entries should be
+10 ; displayed in the worklist
+11 ; PATLOC - Formats the Clinic or Ward name for display on the HCSR
+12 ; Worklist and the HCSR Response Worklist
+13 ; PNAME - Formats the patient name for display on the HCSR Worklist
+14 ; and the HCSR Response Worklist
+15 ; REFRESH - Protocol action that allows the user to check for recent
+16 ; appointments and admissions, re-select filter options and
+17 ; redisplays the HCSR Worklist
+18 ; SORT1 - Used to sort the entries in the worklist per user selected
+19 ; option
+20 ;-----------------------------------------------------------------------------
+21 ;
REFRESH ;EP
+1 ; Protocol action to search for new appointments/admission, reset filter
+2 ; and redisplay the HCSR Worklist
+3 ; Input: HCSSORT - Current sort selection
+4 ; Output: IBFILTS() - Array of filter criteria
+5 ; ^TMP("IBTRH1",$J) - Body lines to display
+6 ; ^TMP($J,"IBTRH1S") - Sorted Body lines to display
+7 ; ^TMP($J,"IBTRH1IX") - Index of Event IENs by display line
+8 ;
+9 ; First check to see if we can create more event entries
+10 ;;D EN^IBTRHDE(1) ;JWS 3/21/16 - remove this. don't want to create more entries this way
+11 ; Set flag legend
DO VALMSGH^IBTRH1
+12 DO FULL^VALM1
+13 SET VALMBCK="R"
+14 ; Reset Filter criteria
if '$$FILTERS(.IBFILTS)
QUIT
+15 DO CLEAN^VALM10
+16 SET VALMBG=1
+17 ; Sort the entries
DO SORT^IBTRH1(2)
+18 ; Rebuild the worklist
DO INIT^IBTRH1
+19 ; Redisplay the header
DO HDR^IBTRH1
+20 QUIT
+21 ;
FILTERS(FILTERS) ;EP
+1 ; Sets an array of filters to determine which entries in HCSR Transmission
+2 ; file should be displayed to the user
+3 ; Input: None
+4 ; Output: FILTERS(0) - A1^A2 Where:
+5 ; A1 - 0 - 'Output' entries only
+6 ; 1 - 'Input' entries only
+7 ; 2 - Both Output and Input entries
+8 ; A2 - O - CPAC entries only
+9 ; 1 - Champva/Tricare entries only
+10 ; 2 - Both CPAC and Champva/Tricare entries
+11 ; A3 - 0 - No Division filter
+12 ; 1 - Selected Division filter
+13 ; FILTERS(1) - '^' delimited list of included Clinic IENs
+14 ; Null if all clinics are included
+15 ; Only set if FILTERS(0)= 0 OR 2
+16 ; FILTERS(2) - '^' delimited list of included WARD IENs
+17 ; Null if all wards are included
+18 ; Only set if FILTERS(0)= 1 OR 2
+19 ; FILTERS(3) - '^' delimited list of included Division IENs
+20 ; Null if all Divisions are included
+21 ; Returns: 0 if the user entered '^' or timed out, 1 otherwise
+22 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,XX,Y
+23 KILL FILTERS
+24 ;
+25 ; ChampVA/Tricare filter
+26 SET DIR(0)="S"
SET DIR("A")="Show CHAMPVA/TRICARE entries, CPAC entries or Both"
SET DIR("B")="B"
+27 SET DIR("?",1)="Enter 'T' to only view entries created for CHAMPVA/TRICARE"
+28 SET DIR("?",2)="Enter 'C' to only view entries created for CPAC"
+29 SET DIR("?")="Enter 'B' to view entries both CHAMPVA/TRICARE and CPAC entries"
+30 SET $PIECE(DIR(0),"^",2)="T:CHAMPVA/TRICARE;C:CPAC;B:Both"
+31 WRITE !!
DO ^DIR
KILL DIR
+32 IF $GET(DIRUT)
QUIT 0
+33 ;
+34 ; Inpatient/Outpatient filter
+35 SET X=$$UP^XLFSTR(X)
+36 SET $PIECE(FILTERS(0),"^",2)=$SELECT(X="C":0,X="T":1,1:2)
+37 SET DIR(0)="S"
SET DIR("A")="Show Inpatient entries, Outpatient entries or Both"
SET DIR("B")="B"
+38 SET DIR("?",1)="Enter 'I' to only view entries created for inpatients"
+39 SET DIR("?",2)="Enter 'O' to only view entries created for outpatients"
+40 SET DIR("?")="Enter 'B' to view entries both inpatient and outpatient entries"
+41 SET $PIECE(DIR(0),"^",2)="O:Outpatient;I:Inpatient;B:Both"
+42 WRITE !
DO ^DIR
KILL DIR
+43 IF $GET(DIRUT)
QUIT 0
+44 SET X=$$UP^XLFSTR(X)
+45 SET $PIECE(FILTERS(0),"^",1)=$SELECT(X="O":0,X="I":1,1:2)
+46 ;
+47 ; Division filter
+48 SET X=$$UP^XLFSTR(X)
+49 SET $PIECE(FILTERS(0),"^",3)=$SELECT(X="A":0,1:1)
+50 SET DIR(0)="S"
SET DIR("A")="Select(A)ll or (S)elected Divisions"
SET DIR("B")="All"
+51 SET DIR("?",1)="Enter 'A' to not filter by division."
+52 SET DIR("?")="Enter 'S' to view entries for selected division(s)."
+53 SET $PIECE(DIR(0),"^",2)="A:All;S:Selected"
+54 WRITE !
DO ^DIR
KILL DIR
+55 IF $GET(DIRUT)
QUIT 0
+56 SET X=$$UP^XLFSTR(X)
+57 SET $PIECE(FILTERS(0),"^",3)=$SELECT(Y="A":0,1:1)
+58 ;
+59 ; Set Division inclusion filter
+60 IF $PIECE(FILTERS(0),"^",3)=1
DO ASKDIV(.FILTERS)
+61 ;
+62 ; Set Ward inclusion filter
+63 IF $PIECE(FILTERS(0),"^",1)>0
DO ASKWORC(0,.FILTERS)
+64 ;
+65 ; Set Clinic inclusion filter
+66 IF ($PIECE(FILTERS(0),"^",1)=0)!($PIECE(FILTERS(0),"^",1)=2)
DO ASKWORC(1,.FILTERS)
+67 ;
+68 ; If any Division, Clinic or Ward inclusion filters were set, display the final results
+69 IF ($GET(FILTERS(1))'="")!($GET(FILTERS(2))'="")!($GET(FILTERS(3))'="")
Begin DoDot:1
+70 DO SHOWFILT^IBTRH1B(.FILTERS)
End DoDot:1
+71 QUIT 1
+72 ;
ASKDIV(FILTERS) ; Sets a list of Division to be displayed in the HSCR Worklist
+1 ; Input: FILTERS - Current Array of filter settings
+2 ; Output: FILTERS - Updated Array of filter settings
+3 NEW DIC,DIR,DIRUT,DIVS,DUOUT,FIRST,IBIENS,IBIENS2,IEN,N,X,XX,Y
+4 SET DIC=40.8
SET DIC(0)="AE"
SET FIRST=1
+5 FOR
Begin DoDot:1
+6 ; One Division prompt
DO ONEDIV(.DIC,.IEN,.FIRST)
+7 if +IEN<1
QUIT
+8 SET IBIENS($PIECE(IEN,"^",2))=$PIECE(IEN,"^",1)
+9 SET IBIENS2($PIECE(IEN,"^",1))=$PIECE(IEN,"^",2)
End DoDot:1
if +IEN<1
QUIT
+10 IF '$DATA(IBIENS)
SET $PIECE(FILTERS(0),"^",3)=0
QUIT
+11 ;
+12 ; Set the filter node responses in alphabetical order
+13 SET XX=""
+14 FOR
Begin DoDot:1
+15 SET XX=$ORDER(IBIENS(XX))
+16 if XX=""
QUIT
+17 SET N=IBIENS(XX)
+18 SET FILTERS(3)=$SELECT($GET(FILTERS(3))'="":FILTERS(3)_"^"_N,1:N)
End DoDot:1
if XX=""
QUIT
+19 QUIT
+20 ;
ONEDIV(DIC,IEN,FIRST) ; Prompts the user for a division
+1 ; Input: DIC - Variable/Array of settings needed for ^DIC call
+2 ; FIRST - Set to 1 initially and then 0 for subsequent calls
+3 ; Output: FIRST - Set to 0
+4 ; IEN - IEN of the selected Division
+5 ; null of no selection was made
+6 SET DIC("A")=$SELECT(FIRST:"Select a Division: ",1:"Select Another Division: ")
+7 DO ^DIC
+8 SET FIRST=0
SET IEN=Y
+9 QUIT
+10 ;
ASKWORC(WHICH,FILTERS) ; Sets a list of wards or clinics to be displayed in
+1 ; the HCSR Worklist
+2 ; Input: WHICH - 0 Ward selection, 1 - Clinic Selection
+3 ; FILTERS - Current Array of filter settings
+4 ; Output: FILTERS - Updated Array of filter settings
+5 NEW CLINS,DIC,DIR,DIRUT,DIVS,DUOUT,FIRST,IBIENS,IBIENS2,IEN,N,NM,NODE,WARDS,X,XX,Y
+6 SET DIC=$SELECT(WHICH=0:42,1:44)
SET DIC(0)="AE"
SET FIRST=1
+7 SET NODE=$SELECT(WHICH=0:2,1:1)
+8 FOR N=1:1:$LENGTH($GET(FILTERS(3)),"^")
Begin DoDot:1
+9 SET XX=$PIECE($GET(FILTERS(3)),"^",N)
+10 if XX=""
QUIT
+11 SET DIVS(XX)=""
End DoDot:1
+12 ;
+13 IF WHICH=0
Begin DoDot:1
+14 SET N=0
SET NM="Ward"
+15 FOR
Begin DoDot:2
+16 SET N=$ORDER(^IBE(350.9,1,64,N))
+17 if +N=0
QUIT
+18 SET IEN=$PIECE(^IBE(350.9,1,64,N,0),"^",1)
+19 SET WARDS(IEN)=""
End DoDot:2
if +N=0
QUIT
+20 IF $DATA(WARDS)!$DATA(FILTERS(3))
Begin DoDot:2
+21 SET DIC("S")="I $$WCFILT^IBTRH1A(1,Y,.DIVS,"""",.WARDS)"
End DoDot:2
End DoDot:1
+22 IF WHICH=1
Begin DoDot:1
+23 SET N=0
SET NM="Clinic"
+24 FOR
Begin DoDot:2
+25 SET N=$ORDER(^IBE(350.9,1,63,N))
+26 if +N=0
QUIT
+27 SET IEN=$PIECE(^IBE(350.9,1,63,N,0),"^",1)
+28 SET CLINS(IEN)=""
End DoDot:2
if +N=0
QUIT
+29 IF $DATA(CLINS)!$DATA(FILTERS(3))
Begin DoDot:2
+30 SET DIC("S")="I $$WCFILT^IBTRH1A(0,Y,.DIVS,.CLINS,"""")"
End DoDot:2
End DoDot:1
+31 FOR
Begin DoDot:1
+32 ; One Clinic or Ward prompt
DO ONEWORC(.DIC,NM,.IEN,.FIRST)
+33 if +IEN<1
QUIT
+34 SET IBIENS($PIECE(IEN,"^",2))=$PIECE(IEN,"^",1)
+35 SET IBIENS2($PIECE(IEN,"^",1))=$PIECE(IEN,"^",2)
End DoDot:1
if +IEN<1
QUIT
+36 IF '$DATA(IBIENS)
SET FILTERS(NODE)=""
QUIT
+37 ;
+38 ; Set the filter node responses in alphabetical order
+39 SET XX=""
+40 FOR
Begin DoDot:1
+41 SET XX=$ORDER(IBIENS(XX))
+42 if XX=""
QUIT
+43 SET N=IBIENS(XX)
+44 SET FILTERS(NODE)=$SELECT($GET(FILTERS(NODE))'="":FILTERS(NODE)_"^"_N,1:N)
End DoDot:1
if XX=""
QUIT
+45 QUIT
+46 ;
ONEWORC(DIC,WHICH,IEN,FIRST) ; Prompts the user for a clinic or ward
+1 ; Input: DIC - Variable/Array of settings needed for ^DIC call
+2 ; WHICH - 'Ward' or 'Clinic'
+3 ; FIRST - Set to 1 initially and then 0 for subsequent calls
+4 ; Output: FIRST - Set to 0
+5 ; IEN - IEN of the selected Ward or clinic Entry
+6 ; null of no selection was made
+7 SET DIC("A")=$SELECT(FIRST:"Select "_WHICH_": ",1:"Select Another "_WHICH_": ")
+8 DO ^DIC
+9 SET FIRST=0
SET IEN=Y
+10 QUIT
+11 ;
WCFILT(WHICH,IEN,DIVS,CLINS,WARDS) ; Used as a dictionary screen when doing
+1 ; Clinic or Ward inclusion filter lookups.
+2 ; Input: WHICH - 0 - Clinic Lookup
+3 ; 1 - Ward lookup
+4 ; IEN - IEN of the Clinic or Ward being looked up
+5 ; DIVS - Array of Included Divisions (if any)
+6 ; CLINS - Array of Site Parameter included Clinics (if any)
+7 ; WARDS - Array of Site Parameter included Wards (if any)
+8 ; Returns: 1 - Clinic or Ward is valid, 0 otherwise
+9 NEW IDIVS,RETURN,SDIV
+10 SET IDIVS=$SELECT($ORDER(DIVS(""))'="":1,1:0)
+11 SET RETURN=1
+12 ;
+13 ; Clinic filter check
+14 IF WHICH=0
Begin DoDot:1
+15 ; Not on Site param inc list
IF $DATA(CLINS)
IF '$DATA(CLINS(IEN))
SET RETURN=0
QUIT
+16 ;
+17 ; If we have included divisions make sure clinic is for the division
+18 IF IDIVS
Begin DoDot:2
+19 ; Division of the Clinic
SET SDIV=$$GET1^DIQ(44,IEN_",",3.5,"I")
+20 if SDIV=""
QUIT
+21 ; Division not in list
if '$DATA(DIVS(SDIV))
SET RETURN=0
End DoDot:2
QUIT
End DoDot:1
QUIT RETURN
+22 ;
+23 ; Ward filter check
+24 ; On Site param exclusion list
IF $DATA(WARDS)
IF '$DATA(WARDS(IEN))
QUIT 0
+25 ;
+26 ; If we have included divisions make sure ward is for the division
+27 IF IDIVS
Begin DoDot:1
+28 ; Division of the Ward
SET SDIV=$$GET1^DIQ(42,IEN_",",.015,"I")
+29 if SDIV=""
QUIT
+30 ; Division not in list
if '$DATA(DIVS(SDIV))
SET RETURN=0
End DoDot:1
+31 QUIT RETURN
+32 ;
SORT1 ;EP
+1 ; Builds the sorted list of HCSR entries to be displayed on the HCSR Worklist
+2 ; Input: HCSRSORT - Current sort selection
+3 ; IBFILTS() - Array of filter settings. See FILTERS for a
+4 ; detailed explanation of the FILTERS array
+5 ; Output: ^TMP("IBTRH1S",$J) - Sorted Event Entries to display
+6 ;
+7 NEW DFN,CSTAT,ECTR,EIEN,EVDT,EVENT
+8 KILL ^TMP($JOB,"IBTRH1S")
+9 SET ECTR=0
+10 ;
+11 ; Loop through all the statuses that are shown on the worklist
+12 FOR CSTAT=0,1,2,3,4,7,8
Begin DoDot:1
+13 SET EVDT=""
+14 FOR
Begin DoDot:2
+15 SET EVDT=$ORDER(^IBT(356.22,"AD",CSTAT,EVDT))
+16 if EVDT=""
QUIT
+17 SET EIEN=""
+18 FOR
Begin DoDot:3
+19 SET EIEN=$ORDER(^IBT(356.22,"AD",CSTAT,EVDT,EIEN))
+20 if EIEN=""
QUIT
+21 SET EVENT=$GET(^IBT(356.22,EIEN,0))
+22 ; Response entry - skip
if $PIECE(EVENT,"^",13)'=""
QUIT
+23 ; Entry is filtered out
if $$SKIP(EVENT)
QUIT
+24 SET ECTR=ECTR+1
+25 IF '$DATA(ZTQUEUED)
IF '(ECTR#15)
WRITE "."
+26 ; Add one event to sort array
DO ONEEVENT(CSTAT,EIEN,EVENT)
End DoDot:3
if EIEN=""
QUIT
End DoDot:2
if EVDT=""
QUIT
End DoDot:1
+27 QUIT
+28 ;
SKIP(EVENT) ; Checks to see if the specified event entry should display on the
+1 ; list
+2 ; Input: EVENT - Event Entry being checked
+3 ; IBFILTS() - Array of filter settings. See FILTERS for a
+4 ; detailed explanation of the FILTERS array
+5 ; Returns: 1 - Don't display the entry on the list, 0 - Display entry on list
+6 NEW DELAY,IEN,IORO,SKIP,TRICARE,NOW,XX,YY,ZZ
+7 ; Skip if a 215 was triggered
IF $PIECE(EVENT,"^",19)=1
QUIT 1
+8 ; 'I' Inpatient, 'O' Outpatient
SET IORO=$PIECE(EVENT,"^",4)
+9 ; Today's Internal Fileman date
SET NOW=$$DT^XLFDT()
+10 SET DELAY=0
+11 ; Delay Date (if any)
if +$PIECE(EVENT,"^",8)=8
SET DELAY=$PIECE(EVENT,"^",17)
+12 ; Only show outpatients, skip
IF IORO="I"
IF $PIECE(IBFILTS(0),"^",1)=0
QUIT 1
+13 ; Only show inpatients, skip
IF IORO="O"
IF $PIECE(IBFILTS(0),"^",1)=1
QUIT 1
+14 ; Is event for Tricare?
SET TRICARE=$$TRICARE(EVENT)
+15 ; Only show CPAC, Skip
IF $PIECE(IBFILTS(0),"^",2)=0
IF TRICARE
QUIT 1
+16 ; Only show Champ/Tricare, Skip
IF $PIECE(IBFILTS(0),"^",2)=1
IF 'TRICARE
QUIT 1
+17 SET SKIP=0
+18 ;
+19 ; Check Division filter
+20 IF $DATA(IBFILTS(3))
Begin DoDot:1
+21 SET XX="^"_IBFILTS(3)_"^"
SET Y=1
+22 ; Ward IEN
SET IEN=$PIECE(EVENT,"^",5)
+23 ; Clinic IEN
if IEN=""
SET IEN=$PIECE(EVENT,"^",6)
SET Y=0
+24 IF Y
SET ZZ=$$GET1^DIQ(42,IEN_",",.015,"I")
+25 IF '$TEST
SET ZZ=$$GET1^DIQ(44,IEN_",",3.5,"I")
+26 SET ZZ="^"_ZZ_"^"
+27 ; Wrong division
IF XX'[ZZ
SET SKIP=1
End DoDot:1
if SKIP
QUIT 1
+28 ;
+29 ; Check Inpatient entry
+30 IF IORO="I"
Begin DoDot:1
+31 ; No Ward filters display
if $GET(IBFILTS(2))=""
QUIT
+32 ; Ward IEN
SET IEN=$PIECE(EVENT,"^",5)
+33 SET XX="^"_IBFILTS(2)_"^"
+34 ; On inclusion list display
if XX[("^"_IEN_"^")
QUIT
+35 ; Not on inclusion list skip
SET SKIP=1
End DoDot:1
if SKIP
QUIT 1
+36 ;
+37 ; Check Outpatient entry
+38 IF IORO="O"
Begin DoDot:1
+39 ; No Clinic filters display
if $GET(IBFILTS(1))=""
QUIT
+40 ; Clinic IEN
SET IEN=$PIECE(EVENT,"^",6)
+41 SET XX="^"_IBFILTS(1)_"^"
+42 ; On inclusion list display
if XX[("^"_IEN_"^")
QUIT
+43 SET SKIP=1
End DoDot:1
if SKIP
QUIT 1
+44 ;
+45 ; Skip entries that haven't reached their delay date yet
+46 IF DELAY
Begin DoDot:1
+47 IF DELAY'="D"
Begin DoDot:2
+48 ; Delay date not met, skip
if DELAY>NOW
SET SKIP=1
End DoDot:2
QUIT
+49 ; Not Discharge yet, skip
if '$$DISCH(EVENT)
SET SKIP=1
End DoDot:1
if SKIP
QUIT 1
+50 ; Display this entry
QUIT 0
+51 ;
TRICARE(EVENT) ;EP
+1 ; Checks to see if the entry is for a ChampVA/Tricare insurance
+2 ; Input: EVENT - Node 0 of the Event Entry being checked
+3 ; Returns: 1 if the entry is for ChampVA/Tricare Insurance, 0 otherwise
+4 NEW COVTYPE,DFN,IENS,IIEN,IMIEN,INSNAME,GRPLAN,GRPLANTP
+5 ; Patient IEN
SET DFN=$PIECE(EVENT,U,2)
+6 ; Insurance Multiple IEN
SET IMIEN=$PIECE(EVENT,U,3)
SET IENS=IMIEN_","_DFN_","
+7 ; Insurance Company IEN
SET IIEN=$$GET1^DIQ(2.312,IENS,.01,"I")
+8 ;GROUP PLAN 355.3 PTR
SET GRPLAN=$$GET1^DIQ(2.312,IENS,.18,"I")
+9 SET GRPLANTP=$$GET1^DIQ(355.3,GRPLAN_",",.09)
+10 ; Type of Coverage (36/.13)
SET COVTYPE=$$UP^XLFSTR($$GET1^DIQ(36,IIEN_",",.13,"E"))
+11 ; Insurance Company Name
SET INSNAME=$$UP^XLFSTR($$GET1^DIQ(36,IIEN_",",.01))
+12 SET TRICARE=0
+13 if (COVTYPE["TRICARE")!(COVTYPE["CHAMPVA")!(INSNAME["TRICARE")!(INSNAME["CHAMPVA")!(GRPLANTP["CHAMPVA")!(GRPLANTP["TRICARE")
SET TRICARE=1
+14 QUIT TRICARE
+15 ;
DISCH(EVENT) ; Checks to see if the admission of the entry has been discharged
+1 ; Input: EVENT - Node 0 of the Event Entry being checked
+2 ; Returns: 1 if the admission has been discharged, 0 otherwise
+3 NEW ADATE,DA,DFN,DT,FOUND,IADATE,REC
+4 ; DFN of the patient
SET DFN=$PIECE(EVENT,"^",2)
+5 ; Internal Admit date
SET ADATE=$PIECE(EVENT,"^",7)
+6 ; Admission is already discharged
IF ADATE["-"
QUIT 0
+7 SET IADATE=9999999.9999999-ADATE
+8 ; DBIA419
SET DA=$ORDER(^DGPM("ATID1",DFN,IADATE,""))
+9 ; No Patient Movement admission record
if DA=""
QUIT -1
+10 ; Patient has been discharged
IF $$GET1^DIQ(405,DA_",",.17,"I")'=""
QUIT 1
+11 ; Admission is still active
QUIT 0
+12 ;
ONEEVENT(CSTAT,EIEN,EVENT) ; Adds one event to the sorted list
+1 ; Input: HCSRSORT - Current sort selection
+2 ; CSTAT - Status of the event to be added
+3 ; EIEN - Internal IEN of the event being added
+4 ; EVENT - ^IBT(356.22,EIEN,0)
+5 ; Output: ^TMP("IBTRH1S",$J) - Sorted Event entries to display
+6 NEW ADATE,DFN,ESTATUS,HS1,HS2,HS3,ICOB,IENS,IGROUP,IIEN,IMIEN,INAME,ISTATUS
+7 NEW LINE,PCREQ,PNAME,RFLG,URREQ,XX
+8 SET (INAME,LINE,PCREQ,URREQ)=""
+9 ;
+10 ; Symbol to display in front of the patient name (if any)
+11 SET RFLG=$SELECT(CSTAT=1:"#",CSTAT=2:"?",CSTAT=3:"!",CSTAT=4:"-",CSTAT=7:"+",CSTAT=8:"*",1:" ")
+12 ; Patient IEN
SET DFN=$PIECE(EVENT,"^",2)
SET PNAME=""
+13 ; Patient Status 'I' or 'O'
SET ESTATUS=$PIECE(EVENT,"^",4)
+14 SET $PIECE(LINE,"^",2)=ESTATUS
+15 ; Internal Appt/Adm Date/Tm
SET ADATE=$PIECE($PIECE(EVENT,"^",7),"-",1)
+16 SET $PIECE(LINE,"^",3)=$$FMTE^XLFDT(ADATE,"2DZ")
+17 SET ISTATUS=1
+18 ; Appointment sort
IF ESTATUS="O"
IF +HCSRSORT=3
SET ISTATUS=0
+19 ; Admissions sort
IF ESTATUS="I"
IF +HCSRSORT=4
SET ISTATUS=0
+20 ; Set 'PAT NAME' column
SET $PIECE(LINE,"^",1)=$$PNAME(DFN,RFLG,.PNAME)
+21 ; Ward or Clinic
SET $PIECE(LINE,"^",4)=$$PATLOC(EVENT)
+22 ; Insurance Multiple IEN
SET IMIEN=$PIECE(EVENT,"^",3)
SET IENS=IMIEN_","_DFN_","
+23 ; Insurance Company IEN
SET IIEN=$$GET1^DIQ(2.312,IENS,.01,"I")
+24 ; Insurance Group IEN
SET IGROUP=$$GET1^DIQ(2.312,IENS,.18,"I")
+25 ; Insurance Company Name
if +IIEN
SET INAME=$$GET1^DIQ(36,IIEN_",",.01)
+26 if INAME=""
SET INAME="**DELETED**"
+27 ; Level of COB External Display
SET ICOB=$$GET1^DIQ(2.312,IENS,.2,"I")
+28 if ICOB=""
SET ICOB=1
+29 ; Level of COB External Display
SET $PIECE(LINE,"^",5)=$SELECT(ICOB=1:"P",ICOB=2:"S",1:"T")
+30 SET $PIECE(LINE,"^",6)=$EXTRACT(INAME,1,14)
+31 ;
+32 ; Oldest event first
IF +HCSRSORT=1
SET HS1=ADATE
SET HS2=PNAME
SET HS3=ICOB
+33 ; Newest event first
IF +HCSRSORT=2
SET HS1=ADATE*-1
SET HS2=PNAME
SET HS3=ICOB
+34 ; Appointments first
IF +HCSRSORT=3
SET HS1=ISTATUS
SET HS2=PNAME
SET HS3=ICOB
+35 ; Admissions sort
IF +HCSRSORT=4
SET HS1=ISTATUS
SET HS2=PNAME
SET HS3=ICOB
+36 ; Insurance name sort
IF +HCSRSORT=5
Begin DoDot:1
+37 SET HS1=$$UP^XLFSTR(INAME)
SET HS2=PNAME
SET HS3=ICOB
End DoDot:1
+38 ; Pre-Certification Req
SET XX=$PIECE($GET(^IBA(355.3,+IGROUP,0)),"^",6)
+39 SET PCREQ=$SELECT(XX=1:"Y",XX=0:"N",1:"")
+40 ; Utilization Review Req
SET XX=$PIECE($GET(^IBA(355.3,+IGROUP,0)),"^",5)
+41 SET URREQ=$SELECT(XX=1:"Y",XX=0:"N",1:"")
+42 SET $PIECE(LINE,"^",7)=URREQ
+43 SET $PIECE(LINE,"^",8)=PCREQ
+44 ; Service Connected Reasons
SET $PIECE(LINE,"^",9)=$$GETSCR(DFN)
+45 SET ^TMP($JOB,"IBTRH1S",HS1,HS2,HS3,EIEN)=LINE
+46 QUIT
+47 ;
PNAME(DFN,RFLG,PNAME) ;EP
+1 ; Format the patient name column for display in the worklist
+2 ; Input: DFN - Internal IEN of the patient
+3 ; RFLG - Symbol to display in front of the name (if any)
+4 ; Output: PNAME - $P(^DPT(DFN,0),"^",1)
+5 ; Returns: Formatted patient name
+6 NEW PNM,SSN4
+7 if +DFN=0
QUIT ""
+8 ; Patient Name
SET PNAME=$$GET1^DIQ(2,DFN_",",.01)
+9 SET PNM=RFLG_PNAME
SET PNM=$EXTRACT(PNM,1,18)
+10 if $LENGTH(PNM)<18
SET PNM=PNM_$JUSTIFY("",18-$LENGTH(PNM))
+11 ; Last 4 of SSN
SET SSN4=$EXTRACT($$GET1^DIQ(2,DFN_",",.09),6,9)
+12 QUIT PNM_" "_SSN4
+13 ;
PATLOC(EVENT) ;EP
+1 ; Returns the Clinic or Ward associated with the event
+2 ; Input: EVENT - ^IBT(356.22,EIEN,0)
+3 ; Returns: Formatted Clinic or location name
+4 NEW ELOC
+5 SET ELOC=$PIECE(EVENT,"^",5)
+6 ; Ward Name
IF ELOC'=""
Begin DoDot:1
+7 SET ELOC=$$GET1^DIQ(42,ELOC_",",.01)
End DoDot:1
+8 ; Clinic Name
IF '$TEST
Begin DoDot:1
+9 SET ELOC=$PIECE(EVENT,"^",6)
+10 if ELOC'=""
SET ELOC=$$GET1^DIQ(44,ELOC_",",.01)
End DoDot:1
+11 QUIT $EXTRACT(ELOC,1,10)
+12 ;
GETSCR(DFN) ; Retrieves all of the services connected reasons to be displayed
+1 ; Input: DFN - Internal IEN of the patient of the event
+2 ; Returns: SCR - String of Service Connected reasons to be displayed
+3 NEW DGNTARR,SCR,VAERR,VASV,XX
+4 SET SCR=""
+5 ; DBIA #10061
+6 DO SVC^VADPT
IF 'VAERR
Begin DoDot:1
+7 ; Agent Orange Exposure
IF VASV(2)
SET SCR="A"
+8 ; Ionizing Radiation
IF VASV(3)
SET SCR=SCR_"I"
+9 ; Southwest Asia
IF VASV(1)
SET SCR=SCR_"S"
+10 ; Combat Veteran
IF VASV(5)
SET SCR=SCR_"C"
+11 ; Camp Lejeune
IF $GET(VASV(15))
SET SCR=SCR_"L"
+12 QUIT
End DoDot:1
+13 ; Nose/Throat Radium, DBIA3457
SET XX=$$GETCUR^DGNTAPI(DFN,"DGNTARR")
+14 SET XX=$SELECT(XX>0:DGNTARR("INTRP"),1:"")
+15 IF +XX
SET SCR=SCR_"N"
+16 ; Military Sexual Trauma, DBIA2716
SET XX=$PIECE($$GETSTAT^DGMSTAPI(DFN),"^",2)
+17 IF XX="Y"
SET SCR=SCR_"M"
+18 QUIT SCR
