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