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

IBCNSU21.m

Go to the documentation of this file.
  1. IBCNSU21 ;ALB/TAZ - INSURANCE PLAN SELECTOR UTILITY ; 13-OCT-2021
  1. ;;2.0;INTEGRATED BILLING;**702**;21-MAR-94;Build 53
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. LKP(IBCNS,IBIND,IBACT,IBIGN,IBFIL) ; Select Utility for Insurance Company Plans
  1. ;
  1. ;Input:
  1. ; IBCNS - IEN of the Insurance Company (file 36)
  1. ; IBIND - Include Individual Plans? (1 - Yes | 0 - No)
  1. ; IBACT - Optional, defaults to 0
  1. ; 0 - Only allow inactive plans
  1. ; 1 - Only allow active plans
  1. ; 2 - Allow both inactive and active plans to be chosen
  1. ; IBIGN - 0 - search Group Name
  1. ; 1 - search Group Number
  1. ; 2 - search Both Group Name and Group Number
  1. ; IBFIL A^B^C
  1. ; A - 1 - Search for Group(s) that Begin with specified text (case insensitive)
  1. ; 2 - Search for Group(s) that Contain the specified text (case insensitive)
  1. ; 3 - Search for Group(s) in a specified Range (inclusive, case insensitive)
  1. ; B - Begin with text if A=1, Contains Text if A=2 or Range start if A=3
  1. ; C - Range End text (only present when A=3)
  1. ;Output:
  1. ; ^TMP($J,"IBSEL",PIEN) - Array of selected plan iens (where PIEN
  1. ; is the plan IEN) is returned if multiple plans may
  1. ; be selected.
  1. ;
  1. Q:'$G(IBCNS) ; No Insurance Company
  1. N IBMULT,IDX,NUMSEL,SELECTED,VALMBG,VALMCNT,VALMY,VALMHDR
  1. F IDX="IBCNSU21","IBCNSU21A","IBCNSU21IX" K ^TMP(IDX,$J)
  1. S IBIND=+$G(IBIND)
  1. S IBACT=+$G(IBACT)
  1. S IBFIL=$G(IBFIL)
  1. S IBMULT=1,NUMSEL=0
  1. D EN^VALM("IBCNS PLAN SELECTOR")
  1. Q
  1. ;
  1. INIT ; Build the list of plans.
  1. N IBP,X
  1. S VALMCNT=0,VALMBG=1
  1. S IBP=0
  1. F S IBP=$O(^IBA(355.3,"B",+IBCNS,IBP)) Q:'IBP D
  1. . N PLANDATA,PLANOK
  1. . D GETS^DIQ(355.3,+IBP_",",".11;2.01;2.02","EI","PLANDATA")
  1. . I '$$PLANOK(.PLANDATA,IBACT,IBIGN,IBFIL) Q ;Check plans based on selection criteria.
  1. . S VALMCNT=VALMCNT+1
  1. . S X=$$BLDLN(VALMCNT,IBP)
  1. . ;
  1. . S ^TMP("IBCNSU21",$J,VALMCNT,0)=X
  1. . S ^TMP("IBCNSU21",$J,"IDX",VALMCNT,VALMCNT)=IBP
  1. . ;
  1. . S ^TMP("IBCNSU21IX",$J,VALMCNT)=IBP
  1. ;
  1. I '$D(^TMP("IBCNSU21",$J)) D
  1. . S VALMCNT=2,^TMP("IBCNSU21",$J,1,0)=" "
  1. . S ^TMP("IBCNSU21",$J,2,0)=" No plans were identified for this company."
  1. S SELECTED=0
  1. Q
  1. ;
  1. HDR ; Build the list header.
  1. N IBCNS0,IBCNS11,IBCNS13,IBLEAD,X,XX,X1,X2
  1. S IBCNS0=$G(^DIC(36,+IBCNS,0)),IBCNS11=$G(^(.11)),IBCNS13=$G(^(.13))
  1. ;
  1. S X2=$S('IBACT:"Inactive ",IBACT=2:"",1:"Active ")
  1. S IBLEAD=$S(IBIND:"All "_X2,1:X2_"Group ")_"Plans for: "
  1. S X2=$$GET1^DIQ(36,+IBCNS_",",.131) I X2']"" S X2="<not filed>"
  1. S X="Phone: "_X2
  1. S X2=$$GET1^DIQ(36,+IBCNS_",",.01)
  1. S VALMHDR(1)=$$SETSTR^VALM1(X,IBLEAD_X2,81-$L(X),40)
  1. ;
  1. S X2=$$GET1^DIQ(36,+IBCNS_",",.133) I X2']"" S X2="<not filed>"
  1. S X1="Precerts: "_X2
  1. S X2=$$GET1^DIQ(36,+IBCNS_",",.111) I X2']"" S X2="<no street address>"
  1. S X=$TR($J("",$L(IBLEAD)),""," ")_X2
  1. S VALMHDR(2)=$$SETSTR^VALM1(X1,X,81-$L(X1),40)
  1. ;
  1. S X=$$GET1^DIQ(36,+IBCNS_",",.114) I X']"" S X="<no city>"_", "
  1. S X1=$$GET1^DIQ(5,$$GET1^DIQ(36,+IBCNS_",",.115,"I")_",",1) I X1']"" S X1="<no state>"
  1. S X2=$$GET1^DIQ(36,+IBCNS_",",.116) I $L(X2)=9 S X2=$E(X2,1,5)_"-"_$E(X2,6,9)
  1. S X=X_", "_X1_" "_X2
  1. S VALMHDR(3)=$$SETSTR^VALM1(X,"",$L(IBLEAD)+1,80)
  1. ;
  1. S X="#" I $G(IBIND) S X="# + => Indiv. Plan"
  1. I $G(IBACT) S X=$E(X_$J("",23),1,23)_"* => Inactive Plan"
  1. S VALMHDR(4)=$$SETSTR^VALM1("Pre- Pre- Ben",X,64,17)
  1. Q
  1. ;
  1. EXIT ; Exit action.
  1. N IDX
  1. K VALMBCK
  1. M ^TMP($J,"IBSEL")=^TMP("IBCNSU21A",$J) S ^TMP($J,"IBSEL",0)=NUMSEL
  1. F IDX="IBCNSU21","IBCNSU21A","IBCNSU21IX" K ^TMP(IDX,$J)
  1. D CLEAN^VALM10,CLEAR^VALM1
  1. Q
  1. ;
  1. BLD ;
  1. ;Source Data from ^TMP($J,"IBCNSU21")
  1. N IIEN,LINE
  1. S (IIEN,VALMCNT)=0
  1. F S IIEN=$O(^TMP($J,"IBCNSU21",IIEN)) Q:'IIEN D
  1. . S VALMCNT=VALMCNT+1
  1. . S LINE=$$BLDLN(VALMCNT,IIEN)
  1. . D SET^VALM10(VALMCNT,LINE,LINE)
  1. . S ^TMP("IBCNSU21IX",$J,VALMCNT)=IIEN
  1. Q
  1. ;
  1. BLDLN(ICTR,IIEN,DATA) ;EP
  1. ; Builds a line to display one insurance company
  1. ; Input: ICTR - Selection Number
  1. ; IIEN - IEN of the Policy to be displayed
  1. ; ^TMP("IBCNSU21A",$J,IIEN) - Array of currently selected policies
  1. ;
  1. ; Output: LINE - Formatted for setting into the list display
  1. N DATA,LINEVAR
  1. D GETS^DIQ(355.3,+IIEN_",",".02;.05;.06;.07;.08;.09;.11;2.01;2.02","EI","DATA")
  1. S LINEVAR=""
  1. I $D(^TMP("IBCNSU21A",$J,IIEN)) S ICTR=ICTR_">"
  1. S LINEVAR=$$SETFLD^VALM1(ICTR,"","CTR")
  1. I '$G(DATA(355.3,IIEN_",",.02,"I")) S $E(LINEVAR,4)="+"
  1. S LINEVAR=$$SETFLD^VALM1($G(DATA(355.3,IIEN_",",2.01,"E")),LINEVAR,"GNAME")
  1. I $G(DATA(355.3,IIEN_",",.11,"I")) S $E(LINEVAR,24)="*"
  1. S LINEVAR=$$SETFLD^VALM1($G(DATA(355.3,IIEN_",",2.02,"E")),LINEVAR,"GNUM")
  1. S LINEVAR=$$SETFLD^VALM1($G(DATA(355.3,IIEN_",",.09,"E")),LINEVAR,"TYPE")
  1. S LINEVAR=$$SETFLD^VALM1($$YN^IBCNSM($G(DATA(355.3,IIEN_",",.05,"I"))),LINEVAR,"UR")
  1. S LINEVAR=$$SETFLD^VALM1($$YN^IBCNSM($G(DATA(355.3,IIEN_",",.06,"I"))),LINEVAR,"PREC")
  1. S LINEVAR=$$SETFLD^VALM1($$YN^IBCNSM($G(DATA(355.3,IIEN_",",.07,"I"))),LINEVAR,"PREEX")
  1. S LINEVAR=$$SETFLD^VALM1($$YN^IBCNSM($G(DATA(355.3,IIEN_",",.08,"I"))),LINEVAR,"BENAS")
  1. Q LINEVAR
  1. ;
  1. SEL ;EP
  1. ; Protocol Action to select an unselected policy
  1. ; Input: NUMSEL - Current number of selected policies
  1. ; ^TMP("IBCNSU21",$J) - Current Array of displayed policies
  1. ; ^TMP("IBCNSU21IX",$J) - Current Index of displayed policies
  1. ; ^TMP("IBCNSU21A,$J,IIEN) - Current Array of selected policies
  1. ; Output: NUMSEL - Updated number of selected policies
  1. ; ^TMP("IBCNSU21A,$J,IIEN)- Updated Array of selected policies
  1. ; Selected Insurance Company is added to the worklist
  1. ; Error message displayed (potentially)
  1. N DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,ERROR,IEN,IIENS,IX,LINE
  1. S VALMBCK="R",ERROR=0
  1. ;
  1. ; First select the Policy(s) to be selected
  1. S IIENS=$$SELPOL(1,.DLINE,1,"IBCNSU21IX")
  1. I IIENS="" S VALMBCK="R" Q ; None Selected
  1. F IX=1:1:$L(IIENS,",") D
  1. . S IIEN=$P(IIENS,",",IX)
  1. . S LINE=$P(DLINE,",",IX)
  1. . ;
  1. . ; If currently selected, display an error message
  1. . I $D(^TMP("IBCNSU21A",$J,IIEN)) D Q
  1. . . W !,*7,">>>> # ",LINE," is currently selected."
  1. . . S ERROR=1
  1. . D MARK(1,IIEN,LINE,.NUMSEL) ; Show the selection mark
  1. D HDR ; Update the header
  1. D:ERROR PAUSE^VALM1
  1. Q
  1. ;
  1. UNSEL(SELECTED) ;EP
  1. ; Protocol Action to deselect an already selected policy
  1. ; Input: SELECTED - 1 - Called from IBCN POL DESELECT
  1. ; 0 - Called from IBCN DESELECT
  1. ; Optional, defaults to 0
  1. ; NUMSEL - Current number of selected policies
  1. ; ^TMP("IBCNSU21",$J) - Current Array of displayed policies
  1. ; ^TMP("IBCNSU21S",$J) - Current Array of selected policies
  1. ; ^TMP("IBCNSU21IX",$J) - Current Index of displayed policies
  1. ; ^TMP("IBCNSU21A,$J,IIEN)- Current Array of selected policies
  1. ; Output: NUMSEL - Current number of selected policies
  1. ; ^TMP("IBCNSU21A,$J,IIEN)- Updated Array of selected policies
  1. ; Selected policy is removed from the worklist
  1. ; Error message displayed (potentially)
  1. N DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,ERROR,IEN,IIENS,IX,LINE,WARRAY
  1. I '$D(SELECTED) D
  1. . S SELECTED=0,WARRAY="IBCNSU21IX"
  1. E S WARRAY="IBCNSU21SIX"
  1. S VALMBCK="R",ERROR=0
  1. ;
  1. ; First select the Policy(s) to be deselected
  1. S IIENS=$$SELPOL(1,.DLINE,1,WARRAY)
  1. I IIENS="" S VALMBCK="R" Q ; None Selected
  1. F IX=1:1:$L(IIENS,",") D
  1. . S IIEN=$P(IIENS,",",IX)
  1. . S LINE=$P(DLINE,",",IX)
  1. . ;
  1. . ; If not currently selected, display an error message
  1. . I '$D(^TMP("IBCNSU21A",$J,IIEN)) D Q
  1. . . W !,*7,">>>> # ",LINE," is not currently selected. It cannot be deselected."
  1. . . S ERROR=1
  1. . D MARK(0,IIEN,LINE,.NUMSEL) ; Deselect the entry
  1. D HDR ; Update the header
  1. D:ERROR PAUSE^VALM1
  1. Q
  1. ;
  1. MARK(WHICH,IIEN,LINE,NUMSEL) ;EP
  1. ; Mark/Remove 'Selection' from a selected
  1. ; Insurance Company line
  1. ; Input: WHICH - 0 - Remove 'Selection' mark
  1. ; 1 - Set 'Selection' mark
  1. ; IENIN - IEN of the entry to Mark/Remove 'In-Progress'
  1. ; LINE - Line number being marked/unmarked
  1. ; WLIST - Worklist, the user is selecting from.
  1. ; NUMSEL - Current # of selected policies
  1. ; ^TMP("IBCNSU21A",$J)- Current array of selected policies
  1. ; Output: Policy is marked or unmarked as selected
  1. ; NUMSEL - Current # of selected policies
  1. ; ^TMP("IBCNSU21A",$J)- Updated array of selected policies
  1. ;
  1. N TEXT
  1. I WHICH D ; Mark as selected
  1. . S ^TMP("IBCNSU21A",$J,IIEN)=""
  1. . S TEXT=LINE_">",NUMSEL=NUMSEL+1
  1. E D ; Mark as unselected
  1. . K ^TMP("IBCNSU21A",$J,IIEN)
  1. . S TEXT=LINE,NUMSEL=NUMSEL-1
  1. D FLDTEXT^VALM10(LINE,"CTR",TEXT) ; Update display
  1. D WRITE^VALM10(LINE) ; Redisplay line
  1. Q
  1. ;
  1. SELPOL(FULL,DLINE,MULT,WLIST) ;EP
  1. ; Select Insurance Company(s) to on report
  1. ; Also called from IBCNRDV1@UNSEL
  1. ; Input: FULL - 1 - full screen mode, 0 otherwise
  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. ; ^TMP("IBCNSU21IX",$J) - Index of displayed lines of the policy
  1. ; Selector Template.
  1. ; Only used when WLIST="IBCNSU21IX"
  1. ; ^TMP("IBCNSU21SIX",$J) - Index of displayed lines of the policy
  1. ; Selected Template
  1. ; Only used if WLIST is "IBCNSU21SIX"
  1. ; Output: DLINE - Comma delimited list of Line #(s) of the
  1. ; selected Ins Cos
  1. ; Returns: IIEN(s) - Comma delimited string or IENS for the selected policy(s)
  1. ; Error message and "" IENS if multi-selection and not allowed
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,IIEN,IIENS,IX,VALMY,X,Y
  1. S:'$D(MULT) MULT=0
  1. S:'$D(WLIST) WLIST="IBCNSU21"
  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 IIENS=""
  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. ; Let 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 IIEN=$G(^TMP(WLIST,$J,IX))
  1. . S IIENS=$S(IIENS="":IIEN,1:IIENS_","_IIEN)
  1. Q IIENS
  1. ;
  1. SHOWSEL ;EP
  1. ; Protocol action used to display a listman template of the currently
  1. ; selected policies
  1. ; Input: NUMSEL - Current number of selected policies
  1. ; ^TMP("IBCNSU21A",$J,IEN) - Current Array of selected policies
  1. ; Output: NUMSEL - Updated number of selected policies
  1. ; ^TMP("IBCNSU21A",$J,IEN) - Updated Array of selected policies
  1. S VALMBCK="R",SELECTED=1
  1. D EN^VALM("IBCNS POLICIES SELECTED")
  1. I '$D(IBFASTXT) D HDR,INIT
  1. Q
  1. ;
  1. INIT2 ;EP for Show Selections
  1. ; Initialize variables and list array
  1. ; Input: None
  1. ; Output: ^TMP("IBCNSU21S",$J) - Body lines to display
  1. S VALMBCK="R"
  1. K ^TMP("IBCNSU21S",$J),^TMP("IBCNSU21SIX",$J)
  1. D BLD2
  1. Q
  1. ;
  1. BLD2 ; Build listman body for Show Selections
  1. ; Input: None
  1. ; Output: VALMCNT - Total number of lines displayed in the body
  1. ; ^TMP("IBCNSU21S",$J) - Body lines to display
  1. ; ^TMP("IBCNSU21SIX",$J) - Index of Entry IENs by display line
  1. N IIEN,LINE
  1. ;
  1. ; Build the lines to be displayed
  1. S (IIEN,VALMCNT)=0
  1. F S IIEN=$O(^TMP("IBCNSU21A",$J,IIEN)) Q:'IIEN D
  1. . S VALMCNT=VALMCNT+1
  1. . S LINE=$$BLDLN(VALMCNT,IIEN)
  1. . D SET^VALM10(VALMCNT,LINE,LINE)
  1. . S ^TMP("IBCNSU21SIX",$J,VALMCNT)=IIEN
  1. ;
  1. I VALMCNT=0 D
  1. . S ^TMP("IBCNSU21S",$J,1,0)="No Selected Policies were found."
  1. Q
  1. ;
  1. EXIT2 ;EP for Show Selections
  1. ; Exit code
  1. ; Input: None
  1. K ^TMP("IBCNSU21S",$J),^TMP("IBCNSU21SIX",$J)
  1. D CLEAR^VALM1
  1. Q
  1. ;
  1. HELP ;
  1. Q
  1. ;
  1. PLANOK(DATA,IBACT,IBNANU,IBFLT) ;Check to see if plan qualifies
  1. ;Input:
  1. ;DATA - This array is passed by reference. It is constructed by the SETS^DIQ call:
  1. ; D GETS^DIQ(355.3,+IBP_",",".02;.05;.06;.07;.08;.09;.11;2.01;2.02","EI","PLANDATA")
  1. ; It must contain the following fields:
  1. ; .11 - INACTIVE
  1. ; 2.01 - GROUP NAME
  1. ; 2.02 - GROUP NUMBER
  1. ;
  1. ;IBACT - 0 - INACTIVE Group Plans Only
  1. ; 1 - ACTIVE Group Plans Only
  1. ; 2 - Both ACTIVE and INACTIVE Group Plans
  1. ;
  1. ;IBNANU - 1 - Check GROUP NAME only
  1. ; 2 - Check GROUP NUMBER only
  1. ; 3 - Check BOTH
  1. ;
  1. N IBP,INACTIVE,OK
  1. S OK=0
  1. S IBP=$O(DATA(355.3,""))
  1. S INACTIVE=$G(DATA(355.3,IBP,.11,"I")) ;1=Inactive, 0=Active
  1. I 'INACTIVE,'IBACT G PLANOKX ; Plan is Active and looking for Inactive only
  1. I INACTIVE,(IBACT=1) G PLANOKX ; Plan is Inactive and looking for Active only
  1. ;
  1. I 'IBFLT G PLANOKX ;Exit if no filter defined.
  1. ;
  1. I IBNANU=1!(IBNANU=3) D I OK G PLANOKX ;GROUP NAME only or Both
  1. . S OK=$$FILTER($G(DATA(355.3,IBP,2.01,"E")),IBFLT)
  1. I IBNANU=2!(IBNANU=3) D ;GROUP NUMNBER only or Both
  1. . S OK=$$FILTER($G(DATA(355.3,IBP,2.02,"E")),IBFLT)
  1. PLANOKX ;Exit
  1. Q OK
  1. ;
  1. FILTER(STR,FLT) ; Filter Group Name or Number
  1. ;IBFLT A^B^C
  1. ; A - 1 - Search for Group(s) that begin with
  1. ; the specified text (case insensitive)
  1. ; 2 - Search for Group(s) that contain
  1. ; the specified text (case insensitive)
  1. ; 3 - Search for Group(s) in a specified
  1. ; range (inclusive, case insensitive)
  1. ; 4 - Search for Group(s) that are blank (null)
  1. ; B - Begin with text if A=1, Contains Text if A=2 or
  1. ; the range start if A=3
  1. ; C - Range End text (only present when A=3)
  1. ;
  1. N BEG,CHR,END,OK,TYPE
  1. S STR=$$UP^XLFSTR(STR)
  1. S TYPE=$P(FLT,U,1)
  1. S BEG=$$UP^XLFSTR($P(FLT,U,2))
  1. S END=$$UP^XLFSTR($P(FLT,U,3))
  1. S OK=0
  1. ;Blank
  1. I TYPE=4 D G FILTERX
  1. . I STR="" S OK=1
  1. ;Test begins with
  1. I TYPE=1 D G FILTERX
  1. . I ($E(STR,1,$L(BEG))=BEG) S OK=1
  1. ;Test contains
  1. I TYPE=2 D G FILTERX
  1. . I (STR[BEG) S OK=1
  1. ;Test range
  1. I TYPE=3 D G FILTERX
  1. . N XX
  1. . S XX=$E(STR,1,$L(BEG))
  1. . I XX=BEG S OK=1 Q ;Matches begining characters of BEG - include
  1. . I XX']BEG Q ;Preceeds Beg search
  1. . S XX=$E(STR,1,$L(END))
  1. . I XX=END S OK=1 Q ;Matches beginning characters of END - include
  1. . I XX]END Q ;Follows End search
  1. . S OK=1
  1. FILTERX ; Exit
  1. Q OK
  1. ;