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

IBRFIWLA.m

Go to the documentation of this file. 
  1. IBRFIWLA ;ALB/FA - IB LIST OF Request For Additional Information (RFAI) SCREEN ;18-JUL-2015
  1.  ;;2.0;INTEGRATED BILLING;**547**;21-MAR-1994;Build 119
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Continuation of methods for the Request for Additional Information worklist
  1.  ;
  1.  Q
  1.  ;
  1. SORTSET(LEVEL,DEFSORT,IBSORT1,IBDONE) ;EP
  1.  ; Allows the user to select Primary or Secondary sort option
  1.  ; Input:   LEVEL   - 1 - Setting Primary Sort
  1.  ;                    2 - Setting Secondary sort
  1.  ;          DEFSORT - Default sort value
  1.  ;                    Optional, defaults to ""
  1.  ;          IBSORT1 - Current Primary Sort Value
  1.  ;                    Optional, only passed when selecting the Secondary sort
  1.  ; Output:  IBDONE  - 1 if user '^' or timed out, 0 otherwise
  1.  ; Returns: Selected Sort Option
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LEVDESC,LINE,LN,SORT,SKIP,XX,X,Y
  1.  S:'$D(DEFSORT) DEFSORT=""
  1.  S IBDONE=0
  1.  S LEVDESC=$S(LEVEL=2:"Secondary",1:"Primary")
  1.  S DIR("A")="Select "_LEVDESC_" Sort"
  1.  S:DEFSORT'="" DIR("B")=$$SD(DEFSORT)
  1.  S DIR("?")="Enter a code from the list to indicate the "_LEVDESC_" sort order."
  1.  I LEVEL=2 D
  1.  . S DIR("?",1)="  Primary Sort is "_$$SD($G(IBSORT1))
  1.  . S DIR("?",LEVEL)=""
  1.  ;
  1.  I LEVEL=1 S DIR(0)="S"                         ; Primary sort required
  1.  E  S DIR(0)="SO"                               ; Optional Secondary sort
  1.  ;
  1.  ; Set the allowable sort options
  1.  S XX=""
  1.  F LN=1:1 D  Q:SORT=""
  1.  . S SORT=$P($T(ZZ+LN),";",3),SKIP=0            ; Sort Code
  1.  . Q:SORT="END"
  1.  . ;
  1.  . ; Secondary Sort - exclude primary sort or related option
  1.  . I LEVEL=2 D  Q:SKIP
  1.  . . I $P(SORT,":",1)=IBSORT1 S SKIP=1 Q        ; Exclude Primary Sort
  1.  . . I IBSORT1="D",$P(SORT,":",1)="E" S SKIP=1 Q
  1.  . . I IBSORT1="E",$P(SORT,":",1)="D" S SKIP=1 Q
  1.  . . I IBSORT1="N",$P(SORT,":",1)="O" S SKIP=1 Q
  1.  . . I IBSORT1="O",$P(SORT,":",1)="N" S SKIP=1 Q
  1.  . S XX=$S(XX="":SORT,1:XX_";"_SORT)
  1.  S $P(DIR(0),"^",2)=XX
  1.  D ^DIR
  1.  K DIR
  1.  I $D(DTOUT) S IBDONE=1 Q 0                     ; Timeout
  1.  ;I $D(DIRUT),LEVEL=1 S IBDONE=1 Q 0             ; ^ or nil response
  1.  I $D(DIRUT) S IBDONE=1 Q 0             ; ^ or nil response
  1.  Q Y
  1.  ;
  1. SELMSG(PROMPT) ;EP
  1.  ; Select a message
  1.  ; Input:   PROMPT                  - Prompt to display to the user
  1.  ;          ^TMP("IBRFIWLIX",$J,CNT)=RFAIEN
  1.  ; Returns: IEN of the selected message or ""
  1.  N DIROUT,DIRUT,DLINE,DTOUT,DUOUT,END,MCNT,RFAIEN,START,X,Y
  1.  I '$D(^TMP("IBRFIWLIX",$J)) W !!?5,"There are no 'RFAI Messages' to select." D PAUSE^VALM1 Q ""
  1.  S START=1,END=$O(^TMP("IBRFIWLIX",$J,""),-1)
  1.  D FULL^VALM1
  1.  S MCNT=$P($P($G(XQORNOD(0)),"^",4),"=",2)    ; User selection with action
  1.  S MCNT=$TR(MCNT,"/\; .",",,,,,")             ; Check for multi-selection
  1.  ;
  1.  I MCNT["," D  Q ""                           ; Invalid multi-selection
  1.  . W !,*7,">>>> Only single entry selection is allowed"
  1.  . K DIR
  1.  . D PAUSE^VALM1
  1.  S:MCNT="" MCNT=$$SELENTRY(PROMPT,START,END)
  1.  Q:MCNT<1 ""
  1.  S RFAIEN=^TMP("IBRFIWLIX",$J,MCNT)
  1.  Q RFAIEN
  1.  ;
  1. SELENTRY(PROMPT,START,END)    ; select a Message
  1.  ; Input:   PROMPT  - Prompt to be displayed to the user
  1.  ;          START   - Starting Message # that can be selected
  1.  ;          END     - Ending Message # that can be selected
  1.  ; Returns: Selected Message # 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. BLDCOM(RFAIEN,SLINE,ELINE) ; Build the Comment Section (if a comment exists) - called from IBRFIWL1
  1.  ; Input:   RFAIEN  - IEN of the selected Message
  1.  ;          SLINE   - Starting Section Line Number
  1.  ;          ELINE   - Current Ending Section Line Number
  1.  ; Output:  ELINE   - Updated Ending Section Line Number
  1.  ;
  1.  N CBY,CDATE,COM,IX,LI,LIDATA
  1.  S ELINE=$$SET^IBRFIWL1("",$J("",40),SLINE,1)            ; Spacing Blank Line
  1.  I '$O(^IBA(368,RFAIEN,201,0)) Q        ; See if we have a comment
  1.  S ELINE=$$SETN^IBRFIWL1("Comment History",ELINE,1,1)
  1.  ; See if we have a comment
  1.  S LI=0 F  S LI=$O(^IBA(368,RFAIEN,201,LI)) Q:LI'=+LI  D
  1.  . S CDATE=$$GET1^DIQ(368.0201,LI_","_RFAIEN,.01,"I")
  1.  . S CDATE=$$FMTE^XLFDT(CDATE,"2ZM")
  1.  . S CBY=$$GET1^DIQ(368.0201,LI_","_RFAIEN,.02)
  1.  . S ELINE=$$SETN^IBRFIWL1("Comment - Entered By: "_CBY_" on "_CDATE,ELINE,1)
  1.  . S IX=0 F  S IX=$O(^IBA(368,RFAIEN,201,LI,1,IX)) Q:IX=""  S LIDATA=$G(^(IX,0)) D
  1.  .. S ELINE=$$SET^IBRFIWL1("  ",LIDATA,ELINE,1)
  1.  Q
  1.  ;
  1. WRAP(STRING,ROOM,SUBS,IBARY) ; wrap long lines without breaking up words, called from IBRFIWL1
  1.  ;
  1.  ; STRING = data string to wrap
  1.  ; ROOM = number of characters to break at for line 1
  1.  ; SUBS = number of characters to break at for subsequent lines (may or may not be same as ROOM)
  1.  ; IBARY = (required) subscripted array to return wrapped data in:
  1.  ;  array(1)=first line
  1.  ;  array(2)= 2nd line and so on
  1.  ;
  1.  ; Returns total # of lines in description
  1.  ;
  1.  N START,END,I,C
  1.  ; if there is enough room for 1 line, no wrapping needed
  1.  I $L(STRING)'>ROOM S IBARY(1)=STRING Q 1
  1.  ; add a space to the end of the string to avoid dropping last character
  1.  S START=1,END=ROOM,STRING=STRING_" "
  1.  F C=1:1 D  Q:$L(STRING)<START  ; stop if we have made it to the end of the data string
  1.  .; start at the end and work backwards until you find a blank space, cut the line there and move on to the next line 
  1.  .F I=END:-1:1 I $E(STRING,I)=" " S IBARY(C)=$E(STRING,START,I),START=I+1,END=SUBS+START Q
  1.  Q C
  1.  ;
  1. SD(SORT) ;EP
  1.  ; Returns the sort description given the sort code
  1.  ; Input:   SORT    - Sort Code
  1.  ; Returns: Sort Description
  1.  Q $P($P($T(@("ZZ"_$G(SORT))),";",3),":",2)
  1.  ;
  1. ZZ ; List of allowable sort criteria
  1. ZZN ;;N:Earliest Date Received
  1. ZZO ;;O:Latest Date Received
  1. ZZE ;;E:Earliest Due Date
  1. ZZD ;;D:Latest Due Date
  1. ZZI ;;I:Insurance Company Name
  1. ZZP ;;P:Patient Name
  1. ZZB ;;B:Authorizing Biller
  1. ZZL ;;L:LOINC Code
  1. END ;;END
  1.  ;
  1.  Q
  1. PURGWL ; purge file 368 entries based on # of days in PURGE DAYS 277 RFAI 
  1.  ;       in IB SITE PARAMETERS (field #52.02 in file #350.9)
  1.  ; Called from NIGHTLY^IBTRKR (tasked option IB MT NIGHT COMP)
  1.  ; null entry (the default) indicates the transactions will be stored forever.
  1.  N CMTIEN,DA,DIC,DLAYGO,IBPERS,IBRFI,NMIDX,NOW,RMVCOM,WLENDT,WLPRGD
  1.  ; get INTERFACE,IB RFI user id#
  1.  S IBPERS=$$FIND1^DIC(200,,,"INTERFACE,IB RFI")
  1.  S IBPERS=$S(IBPERS:IBPERS,1:.5) ; force to POSTMASTER if unknown 
  1.  ; get Purge in Number of days and WL Ending Date
  1.  S WLPRGD=$$GET1^DIQ(350.9,1,52.02) Q:WLPRGD=""
  1.  S WLENDT=$$FMTHL7^XLFDT($$FMADD^XLFDT(DT,-WLPRGD))
  1.  ; loop through non-deleted entries and see if they meet purge days criteria
  1.  S IBRFI="" F  S IBRFI=$O(^IBA(368,"E",0,IBRFI)) Q:IBRFI=""  D
  1.  . Q:$E($$GET1^DIQ(368,IBRFI,.03,"I"),1,8)>WLENDT
  1.  . ; CHECK FOR REVIEW STATUS (#200.04) I STATUS="1" for "REVIEW IN PROGRESS", QUIT
  1.  . Q:$$GET1^DIQ(368,IBRFI,200.04,"I")=1
  1.  . I '$$LOCKM^IBRFIWL1(IBRFI) Q  ;  unable to remove the WL, due to LOCK
  1.  . ;
  1.  . ; REMOVE WL & SET Comment Entered Date      (^IBA(368,D0,201,D1,0) [1P:200]
  1.  . S DA(1)=IBRFI,DLAYGO=368.0201,DIC(0)="L",DIC="^IBA(368,"_DA(1)_",201,"
  1.  . S X=$$NOW^XLFDT()
  1.  . D FILE^DICN
  1.  . K DD,DO S (CMTIEN,DA)=+Y
  1.  . I DA<1 D UNLOCKM^IBRFIWL1(IBRFI) Q  ; WL locked, unable to create comment multiple
  1.  . ;
  1.  . ; SET Comment Entered By & Comment          (^IBA(368,D0,201,D1,0) [2P:200]
  1.  . S DIE="^IBA(368,"_DA(1)_",201,"
  1.  . S RMVCOM="Entry automatically expired from the RFAI Management Worklist."
  1.  . S DR=".02////"_IBPERS_";.03///"_RMVCOM ;   user INTERFACE,IB RFI
  1.  . D ^DIE
  1.  . K DR,DIE
  1.  . ;
  1.  . ; if comment entered, update deleted flag and date
  1.  . N DA,DIE
  1.  . S DA=IBRFI,DIE=368,NOW=$$NOW^XLFDT()
  1.  . S DR="200.01////1;200.02////"_NOW_";200.03////"_IBPERS ;   User INTERFACE,IB RFI
  1.  . D ^DIE K DR
  1.  . ;
  1.  . D UNLOCKM^IBRFIWL1(IBRFI)
  1.  K CMTIEN,DA,DIC,DLAYGO,IBPERS,IBRFI,IBSTR,NMIDX,NOW,RMVCOM,WLENDT,WLPRGD,WLRVST
  1.  Q
  1.  ;
  1. BLDSLI(RFAIEN,SLINE,ELINE) ; Build the Service Line Information Section - called from IBRFIWL1
  1.  ; Input:   RFAIEN  - IEN of the selected Message
  1.  ;          SLINE   - Starting Section Line Number
  1.  ;          ELINE   - Current Ending Section Line Number
  1.  ; Output:  ELINE   - Updated Ending Section Line Number
  1.  ;
  1.  N SL0,SL1,RFAIEN1,XX,YY,ARY,LN,I
  1.  S ELINE=$$SET^IBRFIWL1("",$J("",40),SLINE,1)            ; Spacing Blank Line-
  1.  S ELINE=$$SETN^IBRFIWL1("Service Line Information / Service Line Status Information",ELINE,1,1)
  1.  ;
  1.  ; Make sure there is line info before wasting everyones time
  1.  I '+$O(^IBA(368,RFAIEN,21,0)) D  Q
  1.  .S ELINE=$$SET^IBRFIWL1("**No line information received** ","",ELINE+1,2)
  1.  .Q
  1.  ;
  1.  S SL0=0
  1.  F  S SL0=$O(^IBA(368,RFAIEN,21,SL0)) Q:SL0'=+SL0  D
  1.  . S RFAIEN1=SL0_","_RFAIEN_","
  1.  . S XX=$$GETFVAL^IBRFIWL("368.021,.1",RFAIEN1,"",0,2)
  1.  . S ELINE=$$SET^IBRFIWL1("Line Item Control Number: ",XX,ELINE,1)
  1.  . S XX=$$GETFVAL^IBRFIWL("368.0121,.11",RFAIEN1,"",3,2)
  1.  . S ELINE=$$SET^IBRFIWL1("Service Line Date: ",XX,ELINE,1)  ;*FA* Same as service date above
  1.  . S XX=$$GETFVAL^IBRFIWL("368.0121,.09",RFAIEN1,"",0,2)
  1.  . S ELINE=$$SET^IBRFIWL1("Revenue Code: ",XX,ELINE,1)
  1.  . S XX=$$GETFVAL^IBRFIWL("368.0121,.02",RFAIEN1,"",0,2)
  1.  . S ELINE=$$SET^IBRFIWL1("Coding Method: ",XX,ELINE,1)
  1.  . S XX=$$GETFVAL^IBRFIWL("368.0121,.03",RFAIEN1,"",0,2)
  1.  . S ELINE=$$SET^IBRFIWL1("Procedure Code: ",XX,ELINE,1)
  1.  . S XX=$$GETFVAL^IBRFIWL("368.0121,.04",RFAIEN1,"",0,2)
  1.  . S:XX'="" ELINE=$$SET^IBRFIWL1("  Procedure Modifier 1: ",XX,ELINE,1)
  1.  . S XX=$$GETFVAL^IBRFIWL("368.0121,.05",RFAIEN1,"",0,2)
  1.  . S:XX'="" ELINE=$$SET^IBRFIWL1("  Procedure Modifier 2: ",XX,ELINE,1)
  1.  . S XX=$$GETFVAL^IBRFIWL("368.0121,.06",RFAIEN1,"",0,2)
  1.  . S:XX'="" ELINE=$$SET^IBRFIWL1("  Procedure Modifier 3: ",XX,ELINE,1)
  1.  . S XX=$$GETFVAL^IBRFIWL("368.0121,.07",RFAIEN1,"",0,2)
  1.  . S:XX'="" ELINE=$$SET^IBRFIWL1("  Procedure Modifier 4: ",XX,ELINE,1)
  1.  . S XX=$$GETFVAL^IBRFIWL("368.0121,.08",RFAIEN1,"",0,2) S:XX]"" XX="$"_XX
  1.  . S ELINE=$$SET^IBRFIWL1("Line Item Charge Amount: ",XX,ELINE,1)
  1.  . S SL1=0 F  S SL1=$O(^IBA(368,RFAIEN,121,SL0,99,SL1)) Q:SL1'=+SL1  D
  1.  .. S RFAIEN1=SL1_","_SL0_","_RFAIEN
  1.  .. S XX=$$GETFVAL^IBRFIWL("368.12199,1.01",RFAIEN1,"",0,2)
  1.  .. S YY=$$GET1^DIQ(368.12199,RFAIEN1,1.01,"I")
  1.  .. I YY S ZZ=$$GET1^DIQ(368.001,YY_",",.02) I ZZ]"" S XX=XX_" - "_ZZ
  1.  .. I XX'="" D
  1.  ... K ARY S LN=$$WRAP^IBRFIWLA(XX,64,79,.ARY)
  1.  ... S ELINE=$$SET^IBRFIWL1("HCCS Category: ",ARY(1),ELINE,1)
  1.  ... F I=2:1:LN S:$D(ARY(LN)) ELINE=$$SET^IBRFIWL1("",ARY(I),ELINE,1)
  1.  .. S XX=$$GETFVAL^IBRFIWL("368.12199,1.02",RFAIEN1,"",0,2)
  1.  .. S YY=$$GET1^DIQ(368.12199,RFAIEN1,1.02,"I")
  1.  .. I YY S ZZ=$P($$GET1^DIQ(368.12199,RFAIEN1,"1.02:80"),":") I ZZ]"" S XX=XX_" - "_ZZ
  1.  .. S LN=$$WRAP^IBRFIWLA(XX,42,79,.ARY)
  1.  .. S ELINE=$$SET^IBRFIWL1("Add'l Info Request Modifier (LOINC): ",ARY(1),ELINE,1)
  1.  .. F I=2:1:LN S:$D(ARY(LN)) ELINE=$$SET^IBRFIWL1("",ARY(I),ELINE,1)
  1.  .. S XX=$$GETFVAL^IBRFIWL("368.12199,10.01",RFAIEN1,"",0,2)
  1.  .. S YY=$$GET1^DIQ(368.12199,RFAIEN1,10.01,"I")
  1.  .. I YY S ZZ=$$GET1^DIQ(368.001,YY_",",.02) I ZZ]"" S XX=XX_" - "_ZZ
  1.  .. I XX'="" D
  1.  ... K ARY S LN=$$WRAP^IBRFIWLA(XX,62,77,.ARY)
  1.  ... S ELINE=$$SET^IBRFIWL1("  HCCS Category: ",ARY(1),ELINE,1)
  1.  ... F I=2:1:LN S:$D(ARY(LN)) ELINE=$$SET^IBRFIWL1("  ",ARY(I),ELINE,1)
  1.  .. S XX=$$GETFVAL^IBRFIWL("368.12199,10.02",RFAIEN1,"",0,2)
  1.  .. S YY=$$GET1^DIQ(368.12199,RFAIEN1,10.02,"I")
  1.  .. I YY S ZZ=$P($$GET1^DIQ(368.12199,RFAIEN1,"10.02:80"),":") I ZZ]"" S XX=XX_" - "_ZZ
  1.  .. I XX'="" D
  1.  ... K ARY S LN=$$WRAP^IBRFIWLA(XX,48,77,.ARY)
  1.  ... S ELINE=$$SET^IBRFIWL1("  Add'l Info Request Modifier: ",ARY(1),ELINE,1)
  1.  ... F I=2:1:LN S:$D(ARY(LN)) ELINE=$$SET^IBRFIWL1("  ",ARY(I),ELINE,1)
  1.  .. S XX=$$GETFVAL^IBRFIWL("368.12199,11.01",RFAIEN1,"",0,2)
  1.  .. S YY=$$GET1^DIQ(368.12199,RFAIEN1,11.01,"I")
  1.  .. I YY S ZZ=$$GET1^DIQ(368.001,YY_",",.02) I ZZ]"" S XX=XX_" - "_ZZ
  1.  .. I XX'="" D
  1.  ... K ARY S LN=$$WRAP^IBRFIWLA(XX,62,77,.ARY)
  1.  ... S ELINE=$$SET^IBRFIWL1("  HCCS Category: ",ARY(1),ELINE,1)
  1.  ... F I=2:1:LN S:$D(ARY(LN)) ELINE=$$SET^IBRFIWL1("  ",ARY(I),ELINE,1)
  1.  .. S XX=$$GETFVAL^IBRFIWL("368.12199,11.02",RFAIEN1,"",0,2)
  1.  .. S YY=$$GET1^DIQ(368.12199,RFAIEN1,11.02,"I")
  1.  .. I YY S ZZ=$P($$GET1^DIQ(368.12199,RFAIEN1,"11.02:80"),":") I ZZ]"" S XX=XX_" - "_ZZ
  1.  .. I XX'="" D
  1.  ... K ARY S LN=$$WRAP^IBRFIWLA(XX,48,77,.ARY)
  1.  ... S ELINE=$$SET^IBRFIWL1("  Add'l Info Request Modifier: ",ARY(1),ELINE,1)
  1.  ... F I=2:1:LN S:$D(ARY(LN)) ELINE=$$SET^IBRFIWL1("  ",ARY(I),ELINE,1)
  1.  .. S XX=$$GETFVAL^IBRFIWL("368.12199,.02",RFAIEN1,"",3,2)
  1.  .. S ELINE=$$SET^IBRFIWL1("Status Information Effective Date: ",XX,ELINE,1)
  1.  .. ;S ELINE=$$SET^IBRFIWL1("Response Due Date: ","",ELINE,1)
  1.  Q