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

IBJPS6.m

Go to the documentation of this file. 
  1. IBJPS6 ;ALB/WCJ - IB Site Parameters, Administrative Contractors ; 27-AUG-2015
  1.  ;;2.0;INTEGRATED BILLING;**547**;21-MAR-94;Build 119
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;;
  1.  ;
  1.  Q
  1.  ;
  1. EN(WHICH) ; -- main entry point for IBJP ALT PRIM PAYER ID TYP
  1.  ; Input: WHICH     - 1 - Using template IBJP ADMIN CONTRACTOR MED
  1.  ;                    2 - Using template IBJP ADMIN CONTRACTOR COM
  1.  N TEMPLATE
  1.  S TEMPLATE=$S(WHICH=1:"IBJP ADMIN CONTRACTOR MED",1:"IBJP ADMIN CONTRACTOR COM")
  1.  D EN^VALM(TEMPLATE)
  1.  Q
  1.  ;
  1. HDR(WHICH) ; -- header code
  1.  ; Input: WHICH     - 1 - Using template IBJP ADMIN CONTRACTOR MED
  1.  ;                    2 - Using template IBJP ADMIN CONTRACTOR COM
  1.  ;
  1.  S:WHICH=1 VALMHDR(1)="Medicare"
  1.  S:WHICH=2 VALMHDR(1)="Commercial"
  1.  Q
  1.  ;
  1. INIT(WHICH) ; Initialize variables and list array
  1.  ; Input: WHICH     - 1 - Using template IBJP ADMIN CONTRACTOR MED
  1.  ;                    2 - Using template IBJP ADMIN CONTRACTOR COM
  1.  ; Output:  ^TMP("IBJPS6",$J)   - Body lines to display for specified template
  1.  K ^TMP("IBJPS6",$J),^TMP($J,"IBJPS6IX")
  1.  D BLD(WHICH)
  1.  Q
  1.  ;
  1. BLD(WHICH) ; Build screen array, no variables required for input
  1.  ; Input: WHICH     - 1 - Using template IBJP ADMIN CONTRACTOR MED
  1.  ;                    2 - Using template IBJP ADMIN CONTRACTOR COM
  1.  ; Output:  ^TMP("IBJPS6",$J)   - Body lines to display for specified template
  1.  ;
  1.  N CNT,ENTRIES,LINE,NAME,NAMEIEN,NODE,NODE0,Z
  1.  S VALMCNT=0
  1.  S NODE=$S(WHICH=1:81,1:82)
  1.  S (Z,CNT)=0
  1.  F  D  Q:+Z=0
  1.  . S Z=$O(^IBE(350.9,1,NODE,Z))
  1.  . Q:+Z=0
  1.  . S NODE0=$G(^IBE(350.9,1,NODE,Z,0)),NAMEIEN=+$P(NODE0,U,1)
  1.  . I NAMEIEN>0 D
  1.  . . S CNT=CNT+1,NAME=$$EXTERNAL^DILFD(350.9_NODE,.01,"",NAMEIEN)
  1.  . . I NAME'="" D
  1.  . . . S ENTRIES(NAME,CNT)=NAMEIEN,ENTRIES(NAME,CNT,"IEN")=Z
  1.  I '$D(ENTRIES) D  Q
  1.  . S LINE=$$SETL("","","** No entries found **",29,22)
  1.  . S ^TMP("IBJPS6",$J,1,0)=LINE
  1.  ;
  1.  S NAME=""
  1.  F  D  Q:NAME=""
  1.  .S NAME=$O(ENTRIES(NAME)) Q:NAME=""
  1.  .S Z=0 F  D  Q:Z=""
  1.  ..S Z=$O(ENTRIES(NAME,Z)) Q:Z=""
  1.  ..S VALMCNT=VALMCNT+1
  1.  ..S LINE=$$BLDLN(VALMCNT,NAME,ENTRIES(NAME,Z))
  1.  ..D SET^VALM10(VALMCNT,LINE,VALMCNT)
  1.  ..S ^TMP($J,"IBJPS6IX",VALMCNT)=ENTRIES(NAME,Z,"IEN")
  1.  ..Q
  1.  .Q
  1.  Q
  1.  ;
  1. BLDLN(CTR,NAME,IEN) ; Builds a line to display and insurance
  1.  ; Input:   CTR     - Current Line Counter
  1.  ;          NAME    - Insurance Company Name
  1.  ;          IEN     - IEN of the insurance to be displayed
  1.  ; Output:  LINE    - Formatted for settng into the list display
  1.  N LINE,XX
  1.  S LINE=$$SETSTR^VALM1(CTR,"",1,4)                  ; Entry #
  1.  S LINE=$$SETSTR^VALM1(NAME,LINE,6,66)              ; Administrative Contractor Type
  1.  Q LINE
  1.  ;
  1. SETL(LINE,DATA,LABEL,COL,LNG) ; Creates a line of data to be set into the body
  1.  ; of the worklist
  1.  ; Input:   LINE    - Current line being created
  1.  ;          DATA    - Information to be added to the end of the current line
  1.  ;          LABEL   - Label to describe the information being added
  1.  ;          COL     - Column position in line to add information add
  1.  ;          LNG     - Maximum length of data information to include on the line
  1.  ; Returns: Line updated with added information
  1.  S LINE=LINE_$J("",(COL-$L(LABEL)-$L(LINE)))_LABEL_$E(DATA,1,LNG)
  1.  Q LINE
  1.  ;
  1. HELP(WHICH) ; -- help code
  1.  ; Input: WHICH     - 1 - Using template IBJP ADMIN CONTRACTOR MED
  1.  ;                    2 - Using template IBJP ADMIN CONTRACTOR COM
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT(WHICH) ; Exit code
  1.  ; Input: WHICH     - 1 - Using template IBJP ADMIN CONTRACTOR MED
  1.  ;                    2 - Using template IBJP ADMIN CONTRACTOR COM
  1.  K ^TMP("IBJPS6",$J),^TMP($J,"IBJPS6IX")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. ADD(WHICH) ; Listman Protocol Action to add an entry to the specified Site Parameter node
  1.  ; Input: WHICH     - 1 - Using template IBJP ADMIN CONTRACTOR MED
  1.  ;                    2 - Using template IBJP ADMIN CONTRACTOR COM
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,FDA,IEN,IENS,INSM,INSMC
  1.  N NODE,NAME,NAMEU,NODE0,X,XX,Y,Z,Z1
  1.  S NODE=$S(WHICH=1:81,1:82)
  1.  S VALMBCK="R"                                  ; Refresh screen on return
  1.  Q:'$$LOCK(NODE)                                ; Couldn't lock for adding
  1.  D FULL^VALM1
  1.  ;
  1.  I '$$ENTSEL(NODE,.IENS,WHICH) D  Q           ; Select entry(s) to be added
  1.  . S VALMSG="No Primary ID Types selected"
  1.  . D UNLOCK(NODE)
  1.  ;
  1.  ; Add the selected entries into the list
  1.  S IEN=""
  1.  F  D  Q:IEN=""
  1.  . S IEN=$O(IENS(IEN))
  1.  . Q:IEN=""
  1.  . Q:$$FIND1^DIC("350.9"_NODE,",1,","QX",IEN)   ; don't add it, it's already there. 
  1.  . S FDA("350.9"_NODE,"+1,1,",.01)=IEN
  1.  . D UPDATE^DIE("","FDA")
  1.  D UNLOCK(NODE)                                 ; Unlock the Node
  1.  ;
  1.  D INIT(WHICH)                                  ; Rebuild list body
  1.  S VALMSG="Added Primary ID Types"
  1.  Q
  1.  ;
  1. DEL(WHICH) ; Listman Protocol Action to delete an entry from the specified Site Parameter node
  1.  ; Input: WHICH     - 1 - Using template IBJP ADMIN CONTRACTOR MED
  1.  ;                    2 - Using template IBJP ADMIN CONTRACTOR COM
  1.  ;
  1.  N CNT,CNT2,DA,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LIST,NAME
  1.  N NODE,NODE0,SELSTR,STR,X,XX,Y,Z,Z1,OTHER,SKIPPED,DELETED
  1.  S NODE=$S(WHICH=1:81,1:82)
  1.  S OTHER=$S(NODE=82:81,1:82)
  1.  S VALMBCK="R"                                  ; Refresh screen on return
  1.  Q:'$$LOCK(NODE)                                ; Couldn't lock for deletion
  1.  D FULL^VALM1                                    ; Display warning message
  1.  S STR=$$SELEVENT(0,"",.SELSTR,1,"IBJPS6IX")
  1.  ; 
  1.  I STR="" D  Q           ; Select entry(s) to be added
  1.  . S VALMSG="No Pimary ID Types selected"
  1.  . S VALMBCK="R"  ; resetting this variable which disappeared to refresh screen
  1.  . D UNLOCK(NODE)
  1.  ;
  1.  I STR'="" D
  1.  . F Z=1:1:$L(STR,",") D
  1.  . . S Z1=$P(STR,",",Z),NODE0=$G(^IBE(350.9,1,NODE,Z1,0))
  1.  . . S NAME=$$EXTERNAL^DILFD(350.9_NODE,.01,"",+$P(NODE0,"^",1))
  1.  . . S LIST(Z1)=NAME
  1.  . . S LIST(Z1,"I")=+NODE0
  1.  ;
  1.  ; Delete the selected entries from the list
  1.  S DA(1)=1,(CNT,CNT2,DA)=0
  1.  S SKIPPED=""
  1.  F  S DA=$O(LIST(DA)) Q:'DA  D
  1.  . I $D(^DIC(36,"AB",LIST(DA,"I")))!($D(^DIC(36,"AD",LIST(DA,"I")))),'$D(^IBE(350.9,1,OTHER,"B",LIST(DA,"I"))) D  Q  ; don't let them delete ones in use
  1.  .. S CNT2=CNT2+1
  1.  .. S SKIPPED=$S($G(SKIPPED)]"":SKIPPED_",",1:"")_LIST(DA)
  1.  .. Q
  1.  . S CNT=CNT+1
  1.  . S DELETED=$S($G(DELETED)]"":DELETED_",",1:"")_LIST(DA)
  1.  . S DIK="^IBE(350.9,"_DA(1)_","_NODE_","
  1.  . D ^DIK
  1.  S DIR(0)="EA",Z=1
  1.  S DIR("A",Z)=" ",Z=Z+1
  1.  I STR="" S DIR("A",Z)="No records selected",Z=Z+1
  1.  I STR'="" D
  1.  . I $D(LIST) D 
  1.  . . S Z1=0
  1.  . . I CNT D
  1.  . . . S DIR("A",Z)="The following "_CNT_" primary ID type"_$S(CNT>1:"s",1:"")_" deleted:",Z=Z+1
  1.  . . . S DIR("A",Z)=DELETED,Z=Z+1
  1.  . . . Q
  1.  . . I CNT2 D
  1.  . . . S DIR("A",Z)="The following "_CNT2_" primary ID type"_$S(CNT2>1:"s are",1:" is")_" in use and cannot be deleted:",Z=Z+1
  1.  . . . S DIR("A",Z)=SKIPPED,Z=Z+1
  1.  . . . S DIR("A",Z)="You must delete the ID from the Insurance Company file first.",Z=Z+1
  1.  S DIR("A",Z)=" ",Z=Z+1
  1.  S DIR("A")="Press RETURN to continue "
  1.  D ^DIR
  1.  D UNLOCK(NODE)                                 ; Unlock Site Parameter node
  1.  I STR]"" D INIT(WHICH)                                  ; Rebuild list body
  1.  Q
  1.  ;
  1. ENTSEL(NODE,IENS,WHICHF)   ; Selects an entry to be added to the specified Site Parameter Node
  1.  ; Input:
  1.  ;              NODE      - Site Parameter node where the data resides
  1.  ;              IENS      - not really being passed in
  1.  ;              WHICHF    - 1 - Using template IBJP ADMIN CONTRACTOR MED
  1.  ;                          2 - Using template IBJP ADMIN CONTRACTOR COM 
  1.  ; Output:      IENS        - Array of selected IEN(s), "" if not selected
  1.  ; Returns:     1           - At least one IEN selected, 0 otherwise
  1.  N DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,IX,STOP,STOP2,X,XX,Y
  1.  N TARGET,ERROR,FDA,FDAIEN,IBSAVEX,SCREEN,IBNODE
  1.  K IENS
  1.  S IBNODE=$S(WHICHF=1:81,1:82)
  1.  S STOP=0
  1.  ;
  1.  F  D  Q:STOP
  1.  . K DIR
  1.  . S DIR(0)="355.98,.01O^^S X=$$UP^XLFSTR(X)"   ; "O" is for optional
  1.  . S DIR("A")="Enter a Primary ID Type"
  1.  . D ^DIR
  1.  . I $G(DIRUT) S STOP=1 Q
  1.  . K DILIST,FDA,TARGET,ERROR,FDAIEN
  1.  . S X=$$UP^XLFSTR(X)
  1.  . S IBSAVEX=X
  1.  . S SCREEN="I '$D(^IBE(350.9,1,IBNODE,""B"",+Y))"  ; screen out the ones already there.  After all, this is the add action
  1.  . D FIND^DIC(355.98,,,"O",X,"*",,SCREEN,,"TARGET","ERROR")  ; looks for an exact match 1st.  If not, then look for partials.
  1.  . ;
  1.  . ; There was one match but already in the mulitple.  Can't add it if it's already there.
  1.  . I +$G(TARGET("DILIST",0))=0,$D(^IBA(355.98,"B",IBSAVEX)) Q
  1.  . ;
  1.  . ; found one entry in the file that was not in the mutiple already.  see if that's it
  1.  . I +$G(TARGET("DILIST",0))=1 D  Q:$G(STOP)  Q:Y
  1.  . . W $E($G(TARGET("DILIST",1,1)),$L(IBSAVEX)+1,99) ; only found one so write the rest of it if it was a partial match 
  1.  . . K DIR
  1.  . . S DIR(0)="Y",DIR("B")="YES",DIR("A")="OK" D ^DIR
  1.  . . I $G(DIRUT) S STOP=1 Q
  1.  . . ; they said it wasn't the one so STOP if the entered value was an exact match to one in the file.
  1.  . . ; Don't if it's not; they may want to add later
  1.  . . I 'Y S:IBSAVEX=$G(TARGET("DILIST",1,1)) STOP=1 K TARGET Q
  1.  . . S IENS(+$G(TARGET("DILIST",2,1)))=""
  1.  . ;
  1.  . ; found more than one entry, pick one
  1.  . I +$G(TARGET("DILIST",0))>1 D  Q:$G(STOP)  Q:$D(TARGET)
  1.  . . F I=1:1:+$G(TARGET("DILIST",0)) W !,I,?3,TARGET("DILIST",1,I)
  1.  . . S DIR(0)="NO^1:"_+$G(TARGET("DILIST",0))
  1.  . . D ^DIR
  1.  . . I $G(DUOUT) S STOP=1 Q  ; ^ out
  1.  . . I $G(X) S IENS(+$G(TARGET("DILIST",2,X)))="" Q  ; actually selected one
  1.  . . I X="" S:$D(^IBA(355.98,"B",IBSAVEX)) STOP=1 K TARGET Q  ; set STOP if it was already in the file.  
  1.  . ;
  1.  . ; either found no entries or didn't like the the others.
  1.  . I '+$G(TARGET("DILIST",0)) D  Q  ; no matches so add it to 355.98
  1.  . . K DIR
  1.  . . S DIR(0)="Y",DIR("B")="YES",DIR("A")="OK to Add"_$S($D(TARGET):"",1:" '"_IBSAVEX_"'") D ^DIR
  1.  . . I $G(DIRUT) S STOP=1 Q
  1.  . . I 'Y Q
  1.  . . S FDA("355.98","+1,",.01)=IBSAVEX
  1.  . . D UPDATE^DIE("ES","FDA","FDAIEN")
  1.  . . S IENS(+FDAIEN(1))=""
  1.  . ; I had a list but didn't like any of them.  Should I add?
  1.  .
  1.  ;
  1.  I '$D(IENS) Q 0                                ; No IENS selected
  1.  Q 1
  1.  ;
  1. LOCK(NODE)  ;EP
  1.  ; Attempt to lock the Site Parameter node that is being worked
  1.  ; Input:   NODE        - Site Parameter node where the data resides
  1.  ; Returns: 1           - Successfully locked
  1.  ;          0           - Not successfully locked and an error message is
  1.  ;                        displayed
  1.  N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,TEXT,X,Y
  1.  L +^IBE(350.9,1,NODE):1
  1.  I '$T D  Q 0
  1.  . S:NODE=81 TEXT="Medicare Primary ID Types"
  1.  . S:NODE=82 TEXT="Commercial Primary ID Types"
  1.  . W @IOF,"Someone else is editing the "_TEXT
  1.  . W !,"Please Try again later"
  1.  . D PAUSE^VALM1
  1.  Q 1
  1.  ;
  1. UNLOCK(NODE) ;EP
  1.  ; Unlocks the Site Parameter node that is being worked
  1.  ; Input:   NODE        - Site Parameter node where the data resides
  1.  L -^IBE(350.9,1,NODE)
  1.  Q
  1.  ;
  1. SELEVENT(FULL,PROMPT,DLINE,MULT,WLIST)    ; 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.  ;          MULT                - 1 to allow multiple entry selection
  1.  ;                                0 to only allow single entry selection
  1.  ;                                Optional, defaults to 0
  1.  ;          WLIST               - Worklist, the user is selecting from
  1.  ;                                Set to 'IBTRH5IX' when called from the
  1.  ;                                response worklist.
  1.  ;                                Optional, defaults to 'IBTRH1IX' 
  1.  ;          ^TMP($J,"IBJPS6IX") - Index of displayed lines of the HCSR Worklist
  1.  ;                                Only used if WLIST is not 'IBJPS6IX"
  1.  ; Output:  DLINE               - Comma delimitted list of Line #(s) of the 
  1.  ;                                selected entries
  1.  ; Returns: EIN(s) - Comma delimitted string or IENS for the selected entry(s)
  1.  ;          Error message and "" IENS if multi-selection and not allowed
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,EIEN,EIENS,IX,VALMY,X,Y
  1.  S:'$D(WLIST) WLIST="IBJPS6IX"
  1.  D:FULL FULL^VALM1
  1.  S DLINE=$P($P($G(XQORNOD(0)),"^",4),"=",2)     ; User selection with action
  1.  S DLINE=$TR(DLINE,"/\; .",",,,,,")             ; Check for multi-selection
  1.  S EIENS=""
  1.  ;
  1.  I 'MULT,DLINE["," D  Q ""                      ; Invalid multi-selection
  1.  . W !,*7,">>>> Only single entry selection is allowed"
  1.  . S DLINE=""
  1.  . K DIR
  1.  . D PAUSE^VALM1
  1.  ;
  1.  ; Check the user enter their selection(s)
  1.  D EN^VALM2($G(XQORNOD(0)),"O")     ; ListMan generic selector
  1.  I '$D(VALMY) Q ""
  1.  S IX="",DLINE=""
  1.  F  D  Q:IX=""
  1.  . S IX=$O(VALMY(IX))
  1.  . Q:IX=""
  1.  . S DLINE=$S(DLINE="":IX,1:DLINE_","_IX)
  1.  . S EIEN=$G(^TMP($J,WLIST,IX))
  1.  . S EIENS=$S(EIENS="":EIEN,1:EIENS_","_EIEN)
  1.  Q EIENS