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

IBTRH1A.m

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