- IBCNSU2 ;ALB/NLR - INSURANCE PLAN LOOK-UP UTILITY ; 20-OCT-2015
- ;;2.0;INTEGRATED BILLING;**28,62,497,549**;21-MAR-94;Build 54
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- LKP(IBCNS,IBIND,IBMULT,IBSEL,IBALR,IBW,IBTLE) ; Look-up Utility for
- ;IB*2.0*549 passing of new input variable IBTLE
- ; Insurance Company Plans
- ;
- ; IB*2.0*549 - Added 2 for IBW option to only allow inactive Plan selection
- ; Input: IBCNS - IEN of the Insurance Company (file 36)
- ; IBIND - Include Individual Plans? (1 - Yes | 0 - No)
- ; IBMULT - If set to 1, allows multiple plans to be chosen
- ; IBALR - May be set to point to a plan in file #355.3
- ; to be excluded from selection
- ; IBW - 1 - Allow both inactive and active plans to be chosen
- ; 2 - Only allow inactive plans
- ; 0 - Only allow active plans
- ; Optional, defaults to 0
- ; IBTLE - If set, then change the variable VALM("TITLE") to
- ; contain the value of IBTLE (IB*2.0*549)
- ; Output: IBSEL - IEN of the plan in file #355.3 if only a single plan
- ; is to be selected.
- ; ^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 VALMY,VALMHDR
- S IBIND=$G(IBIND)>0
- S:'$D(IBW) IBW=0
- S:'$D(IBTLE) IBTLE=""
- S IBMULT=+$G(IBMULT),IBSEL=0
- D EN^VALM("IBCNS PLAN LOOKUP")
- Q
- ;
- INIT ; Build the list of plans.
- N IBP,IBCPOLD,X,IBCPOLD2 ;WCJ;IB*2*497
- K ^TMP("IBCNSJ",$J)
- S VALMCNT=0,VALMBG=1
- S IBP=0
- F S IBP=$O(^IBA(355.3,"B",+IBCNS,IBP)) Q:'IBP D
- . S IBCPOLD=$G(^IBA(355.3,+IBP,0))
- . S IBCPOLD2=$G(^IBA(355.3,+IBP,2)) ; WCJ;IB*2.0*497
- . I 'IBIND,'$P(IBCPOLD,"^",2) Q ; Exclude individual plans
- . I 'IBW,$P(IBCPOLD,"^",11) Q ; Plan is inactive
- . ;
- . ; IB*2.0*549 - Added check to only display inactive plans
- . I IBW=2,$P(IBCPOLD,"^",11)'=1 Q ; Plan is active
- . ;
- . S VALMCNT=VALMCNT+1
- . S X=$$SETFLD^VALM1(VALMCNT,"","NUMBER")
- . I '$P(IBCPOLD,"^",2) S $E(X,4)="+"
- . S X=$$SETFLD^VALM1($P(IBCPOLD2,"^",1),X,"GNAME") ;WCJ;IB*2.0*497
- . I $P(IBCPOLD,"^",11) S $E(X,24)="*"
- . S X=$$SETFLD^VALM1($P(IBCPOLD2,"^",2),X,"GNUM") ;WCJ;IB*2.0*497
- . S X=$$SETFLD^VALM1($$EXPAND^IBTRE(355.3,.09,$P(IBCPOLD,"^",9)),X,"TYPE")
- . S X=$$SETFLD^VALM1($$YN^IBCNSM($P(IBCPOLD,"^",5)),X,"UR")
- . S X=$$SETFLD^VALM1($$YN^IBCNSM($P(IBCPOLD,"^",6)),X,"PREC")
- . S X=$$SETFLD^VALM1($$YN^IBCNSM($P(IBCPOLD,"^",7)),X,"PREEX")
- . S X=$$SETFLD^VALM1($$YN^IBCNSM($P(IBCPOLD,"^",8)),X,"BENAS")
- . ;
- . S ^TMP("IBCNSJ",$J,VALMCNT,0)=X
- . S ^TMP("IBCNSJ",$J,"IDX",VALMCNT,VALMCNT)=IBP
- ;
- I '$D(^TMP("IBCNSJ",$J)) D
- . S VALMCNT=2,^TMP("IBCNSJ",$J,1,0)=" "
- . S ^TMP("IBCNSJ",$J,2,0)=" No plans were identified for this company."
- Q
- ;
- HDR ; Build the list header.
- ; Input: IBTLE - If not null, then change the variable VALM("TITLE") to
- ; contain the value of IBTLE (IB*2.0*549)
- N IBCNS0,IBCNS11,IBCNS13,IBLEAD,X,XX,X1,X2
- I IBTLE'="" S VALM("TITLE")=IBTLE ; IB*2.0*549
- S IBCNS0=$G(^DIC(36,+IBCNS,0)),IBCNS11=$G(^(.11)),IBCNS13=$G(^(.13))
- S X2=$S(IBW=2:"Inactive ",IBW:"",1:"Active ")
- ;
- ; IB*2.0*549 changed 'Plans for' to 'Plans In' for Move Subscriber lookup
- S XX=$S(IBTLE="Group Plan Lookup":"Plans In: ",1:"Plans for: ")
- S IBLEAD=$S(IBIND:"All "_X2,1:X2_"Group ")_XX
- S X="Phone: "_$S($P(IBCNS13,"^")]"":$P(IBCNS13,"^"),1:"<not filed>")
- S VALMHDR(1)=$$SETSTR^VALM1(X,IBLEAD_$P(IBCNS0,"^"),81-$L(X),40)
- S X1="Precerts: "_$S($P(IBCNS13,"^",3)]"":$P(IBCNS13,"^",3),1:"<not filed>")
- S X=$TR($J("",$L(IBLEAD)),""," ")_$S($P(IBCNS11,"^")]"":$P(IBCNS11,"^"),1:"<no street address>")
- S VALMHDR(2)=$$SETSTR^VALM1(X1,X,81-$L(X1),40)
- S X=$S($P(IBCNS11,"^",4)]"":$P(IBCNS11,"^",4),1:"<no city>")_", "
- S X=X_$S($P(IBCNS11,"^",5):$P($G(^DIC(5,$P(IBCNS11,"^",5),0)),"^",2),1:"<no state>")_" "_$E($P(IBCNS11,"^",6),1,5)_$S($E($P(IBCNS11,"^",6),6,9)]"":"-"_$E($P(IBCNS11,"^",6),6,9),1:"")
- S VALMHDR(3)=$$SETSTR^VALM1(X,"",$L(IBLEAD)+1,80)
- S X="#" I $G(IBIND) S X="# + => Indiv. Plan"
- I $G(IBW) S X=$E(X_$J("",23),1,23)_"* => Inactive Plan"
- S VALMHDR(4)=$$SETSTR^VALM1("Pre- Pre- Ben",X,64,17)
- Q
- ;
- FNL ; Exit action.
- K ^TMP("IBCNSJ",$J),VALMBCK
- D CLEAN^VALM10,CLEAR^VALM1
- Q
- ;
- SP ; 'Select Plan' Action
- N DIR,DIRUT,DUOUT,DTOUT,DIROUT,IBOK,IBQUIT,IBX,Y
- D EN^VALM2($G(XQORNOD(0)),"O"),FULL^VALM1
- S IBX=$O(VALMY(0)),VALMBCK="R"
- I 'IBX W !!,"No plan selected!" D SPQ Q
- I 'IBMULT D G SPQ
- . I $O(VALMY(IBX)) W !!,*7,"You may only select a single plan!" Q
- . I $G(IBALR),+$G(^TMP("IBCNSJ",$J,"IDX",IBX,IBX))=IBALR D Q
- . . W !!,*7,"This plan is not allowed for selection!"
- . D OK^IBCNSM3
- . I IBQUIT S VALMBCK="Q" Q
- . I IBOK S IBSEL=+$G(^TMP("IBCNSJ",$J,"IDX",IBX,IBX)),VALMBCK="Q"
- ;
- S IBX=0
- F S IBX=$O(VALMY(IBX)) Q:'IBX D
- . S ^TMP($J,"IBSEL",+$G(^TMP("IBCNSJ",$J,"IDX",IBX,IBX)))=""
- S DIR(0)="Y",DIR("B")="NO",DIR("A")="Would you like to select any other plans"
- S DIR("?")="If you wish to select plans from other screens, please answer 'YES'. Otherwise, answer 'NO'."
- D ^DIR K DIR
- I Y<1!($D(DIRUT)) S VALMBCK="Q"
- ;
- SPQ ;
- I '$O(IBSEL(0)),VALMBCK="R" D PAUSE^VALM1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSU2 5505 printed Mar 13, 2025@21:22:56 Page 2
- IBCNSU2 ;ALB/NLR - INSURANCE PLAN LOOK-UP UTILITY ; 20-OCT-2015
- +1 ;;2.0;INTEGRATED BILLING;**28,62,497,549**;21-MAR-94;Build 54
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- LKP(IBCNS,IBIND,IBMULT,IBSEL,IBALR,IBW,IBTLE) ; Look-up Utility for
- +1 ;IB*2.0*549 passing of new input variable IBTLE
- +2 ; Insurance Company Plans
- +3 ;
- +4 ; IB*2.0*549 - Added 2 for IBW option to only allow inactive Plan selection
- +5 ; Input: IBCNS - IEN of the Insurance Company (file 36)
- +6 ; IBIND - Include Individual Plans? (1 - Yes | 0 - No)
- +7 ; IBMULT - If set to 1, allows multiple plans to be chosen
- +8 ; IBALR - May be set to point to a plan in file #355.3
- +9 ; to be excluded from selection
- +10 ; IBW - 1 - Allow both inactive and active plans to be chosen
- +11 ; 2 - Only allow inactive plans
- +12 ; 0 - Only allow active plans
- +13 ; Optional, defaults to 0
- +14 ; IBTLE - If set, then change the variable VALM("TITLE") to
- +15 ; contain the value of IBTLE (IB*2.0*549)
- +16 ; Output: IBSEL - IEN of the plan in file #355.3 if only a single plan
- +17 ; is to be selected.
- +18 ; ^TMP($J,"IBSEL,PIEN) - Array of selected plan iens (where PIEN
- +19 ; is the plan IEN) is returned if multiple plans may
- +20 ; be selected.
- +21 ;
- +22 ; No Insurance Company
- if '$GET(IBCNS)
- QUIT
- +23 NEW VALMY,VALMHDR
- +24 SET IBIND=$GET(IBIND)>0
- +25 if '$DATA(IBW)
- SET IBW=0
- +26 if '$DATA(IBTLE)
- SET IBTLE=""
- +27 SET IBMULT=+$GET(IBMULT)
- SET IBSEL=0
- +28 DO EN^VALM("IBCNS PLAN LOOKUP")
- +29 QUIT
- +30 ;
- INIT ; Build the list of plans.
- +1 ;WCJ;IB*2*497
- NEW IBP,IBCPOLD,X,IBCPOLD2
- +2 KILL ^TMP("IBCNSJ",$JOB)
- +3 SET VALMCNT=0
- SET VALMBG=1
- +4 SET IBP=0
- +5 FOR
- SET IBP=$ORDER(^IBA(355.3,"B",+IBCNS,IBP))
- if 'IBP
- QUIT
- Begin DoDot:1
- +6 SET IBCPOLD=$GET(^IBA(355.3,+IBP,0))
- +7 ; WCJ;IB*2.0*497
- SET IBCPOLD2=$GET(^IBA(355.3,+IBP,2))
- +8 ; Exclude individual plans
- IF 'IBIND
- IF '$PIECE(IBCPOLD,"^",2)
- QUIT
- +9 ; Plan is inactive
- IF 'IBW
- IF $PIECE(IBCPOLD,"^",11)
- QUIT
- +10 ;
- +11 ; IB*2.0*549 - Added check to only display inactive plans
- +12 ; Plan is active
- IF IBW=2
- IF $PIECE(IBCPOLD,"^",11)'=1
- QUIT
- +13 ;
- +14 SET VALMCNT=VALMCNT+1
- +15 SET X=$$SETFLD^VALM1(VALMCNT,"","NUMBER")
- +16 IF '$PIECE(IBCPOLD,"^",2)
- SET $EXTRACT(X,4)="+"
- +17 ;WCJ;IB*2.0*497
- SET X=$$SETFLD^VALM1($PIECE(IBCPOLD2,"^",1),X,"GNAME")
- +18 IF $PIECE(IBCPOLD,"^",11)
- SET $EXTRACT(X,24)="*"
- +19 ;WCJ;IB*2.0*497
- SET X=$$SETFLD^VALM1($PIECE(IBCPOLD2,"^",2),X,"GNUM")
- +20 SET X=$$SETFLD^VALM1($$EXPAND^IBTRE(355.3,.09,$PIECE(IBCPOLD,"^",9)),X,"TYPE")
- +21 SET X=$$SETFLD^VALM1($$YN^IBCNSM($PIECE(IBCPOLD,"^",5)),X,"UR")
- +22 SET X=$$SETFLD^VALM1($$YN^IBCNSM($PIECE(IBCPOLD,"^",6)),X,"PREC")
- +23 SET X=$$SETFLD^VALM1($$YN^IBCNSM($PIECE(IBCPOLD,"^",7)),X,"PREEX")
- +24 SET X=$$SETFLD^VALM1($$YN^IBCNSM($PIECE(IBCPOLD,"^",8)),X,"BENAS")
- +25 ;
- +26 SET ^TMP("IBCNSJ",$JOB,VALMCNT,0)=X
- +27 SET ^TMP("IBCNSJ",$JOB,"IDX",VALMCNT,VALMCNT)=IBP
- End DoDot:1
- +28 ;
- +29 IF '$DATA(^TMP("IBCNSJ",$JOB))
- Begin DoDot:1
- +30 SET VALMCNT=2
- SET ^TMP("IBCNSJ",$JOB,1,0)=" "
- +31 SET ^TMP("IBCNSJ",$JOB,2,0)=" No plans were identified for this company."
- End DoDot:1
- +32 QUIT
- +33 ;
- HDR ; Build the list header.
- +1 ; Input: IBTLE - If not null, then change the variable VALM("TITLE") to
- +2 ; contain the value of IBTLE (IB*2.0*549)
- +3 NEW IBCNS0,IBCNS11,IBCNS13,IBLEAD,X,XX,X1,X2
- +4 ; IB*2.0*549
- IF IBTLE'=""
- SET VALM("TITLE")=IBTLE
- +5 SET IBCNS0=$GET(^DIC(36,+IBCNS,0))
- SET IBCNS11=$GET(^(.11))
- SET IBCNS13=$GET(^(.13))
- +6 SET X2=$SELECT(IBW=2:"Inactive ",IBW:"",1:"Active ")
- +7 ;
- +8 ; IB*2.0*549 changed 'Plans for' to 'Plans In' for Move Subscriber lookup
- +9 SET XX=$SELECT(IBTLE="Group Plan Lookup":"Plans In: ",1:"Plans for: ")
- +10 SET IBLEAD=$SELECT(IBIND:"All "_X2,1:X2_"Group ")_XX
- +11 SET X="Phone: "_$SELECT($PIECE(IBCNS13,"^")]"":$PIECE(IBCNS13,"^"),1:"<not filed>")
- +12 SET VALMHDR(1)=$$SETSTR^VALM1(X,IBLEAD_$PIECE(IBCNS0,"^"),81-$LENGTH(X),40)
- +13 SET X1="Precerts: "_$SELECT($PIECE(IBCNS13,"^",3)]"":$PIECE(IBCNS13,"^",3),1:"<not filed>")
- +14 SET X=$TRANSLATE($JUSTIFY("",$LENGTH(IBLEAD)),""," ")_$SELECT($PIECE(IBCNS11,"^")]"":$PIECE(IBCNS11,"^"),1:"<no street address>")
- +15 SET VALMHDR(2)=$$SETSTR^VALM1(X1,X,81-$LENGTH(X1),40)
- +16 SET X=$SELECT($PIECE(IBCNS11,"^",4)]"":$PIECE(IBCNS11,"^",4),1:"<no city>")_", "
- +17 SET X=X_$SELECT($PIECE(IBCNS11,"^",5):$PIECE($GET(^DIC(5,$PIECE(IBCNS11,"^",5),0)),"^",2),1:"<no state>")_" "_$EXTRACT($PIECE(IBCNS11,"^",6),1,5)_$SELECT($EXTRACT($PIECE(IBCNS11,"^",6),6,9)]"":"-"_$EXTRACT($PIECE(IBCNS11,"^",6),6,9),1:"")
- +18 SET VALMHDR(3)=$$SETSTR^VALM1(X,"",$LENGTH(IBLEAD)+1,80)
- +19 SET X="#"
- IF $GET(IBIND)
- SET X="# + => Indiv. Plan"
- +20 IF $GET(IBW)
- SET X=$EXTRACT(X_$JUSTIFY("",23),1,23)_"* => Inactive Plan"
- +21 SET VALMHDR(4)=$$SETSTR^VALM1("Pre- Pre- Ben",X,64,17)
- +22 QUIT
- +23 ;
- FNL ; Exit action.
- +1 KILL ^TMP("IBCNSJ",$JOB),VALMBCK
- +2 DO CLEAN^VALM10
- DO CLEAR^VALM1
- +3 QUIT
- +4 ;
- SP ; 'Select Plan' Action
- +1 NEW DIR,DIRUT,DUOUT,DTOUT,DIROUT,IBOK,IBQUIT,IBX,Y
- +2 DO EN^VALM2($GET(XQORNOD(0)),"O")
- DO FULL^VALM1
- +3 SET IBX=$ORDER(VALMY(0))
- SET VALMBCK="R"
- +4 IF 'IBX
- WRITE !!,"No plan selected!"
- DO SPQ
- QUIT
- +5 IF 'IBMULT
- Begin DoDot:1
- +6 IF $ORDER(VALMY(IBX))
- WRITE !!,*7,"You may only select a single plan!"
- QUIT
- +7 IF $GET(IBALR)
- IF +$GET(^TMP("IBCNSJ",$JOB,"IDX",IBX,IBX))=IBALR
- Begin DoDot:2
- +8 WRITE !!,*7,"This plan is not allowed for selection!"
- End DoDot:2
- QUIT
- +9 DO OK^IBCNSM3
- +10 IF IBQUIT
- SET VALMBCK="Q"
- QUIT
- +11 IF IBOK
- SET IBSEL=+$GET(^TMP("IBCNSJ",$JOB,"IDX",IBX,IBX))
- SET VALMBCK="Q"
- End DoDot:1
- GOTO SPQ
- +12 ;
- +13 SET IBX=0
- +14 FOR
- SET IBX=$ORDER(VALMY(IBX))
- if 'IBX
- QUIT
- Begin DoDot:1
- +15 SET ^TMP($JOB,"IBSEL",+$GET(^TMP("IBCNSJ",$JOB,"IDX",IBX,IBX)))=""
- End DoDot:1
- +16 SET DIR(0)="Y"
- SET DIR("B")="NO"
- SET DIR("A")="Would you like to select any other plans"
- +17 SET DIR("?")="If you wish to select plans from other screens, please answer 'YES'. Otherwise, answer 'NO'."
- +18 DO ^DIR
- KILL DIR
- +19 IF Y<1!($DATA(DIRUT))
- SET VALMBCK="Q"
- +20 ;
- SPQ ;
- +1 IF '$ORDER(IBSEL(0))
- IF VALMBCK="R"
- DO PAUSE^VALM1
- +2 QUIT
