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 Oct 16, 2024@18:18:38 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 ;
