- IBCNRPS2 ;BHAM ISC/ALA - Plan Match ListMan ;13-NOV-2003
- ;;2.0;INTEGRATED BILLING;**276,516**;21-MAR-94;Build 123
- ;;Per VA Directive 6402, this routine should not be modified.
- ;;
- EN ; -- main entry point for IBCNR PLAN MATCH
- D EN^VALM("IBCNR PLAN STATUS INQUIRY")
- Q
- ;
- HDR ; -- header code
- N IBCNS0,IBCNS11,IBCNS13,IBLEAD,X,X1,X2
- S IBCNS0=$G(^DIC(36,+IBCNSP,0))
- S IBCNS11=$G(^DIC(36,+IBCNSP,.11))
- S IBCNS13=$G(^DIC(36,+IBCNSP,.13))
- S IBLEAD="All Plans for: "
- 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="For: ",X=$E(X_$J("",23),1,23)_$S(IBCNTYP="A":"All",IBCNTYP="P":"Pharmacy Covered",1:"Matched")_" Group Plans."
- S VALMHDR(4)=$$SETSTR^VALM1(" ",X,64,17)
- Q
- ;
- INIT ; -- init variables and create list array or report array
- N IBGP0,IBCPOLD,X,IBCPD6,IBCNRPP,IBCOV,IBCVRD,LIM
- K ^TMP("IBCNR",$J)
- S VALMCNT=0,VALMBG=1,IBCNGP=0
- F S IBCNGP=$O(^IBA(355.3,"B",IBCNSP,IBCNGP)) Q:'IBCNGP D
- . ; if we want all plans, let it pass
- . I IBCNTYP="A" D Q
- . . D SETPLAN(IBCNGP)
- . ; if we want Pharmacy plans, check for pharms
- . I IBCNTYP="P" D Q
- . . S IBCOV=$O(^IBE(355.31,"B","PHARMACY",""))
- . . S LIM="",IBCVRD=0
- . . F S LIM=$O(^IBA(355.32,"B",IBCNGP,LIM)) Q:LIM="" D
- . . . I $P(^IBA(355.32,LIM,0),U,2)=IBCOV S IBCVRD=$P(^IBA(355.32,LIM,0),U,4)
- . . I IBCVRD D SETPLAN(IBCNGP)
- . ; if we want Matched plans, check for existence of Plan ID
- . I IBCNTYP="M" D Q
- . . I $P($G(^IBA(355.3,IBCNGP,6)),U)'="" D SETPLAN(IBCNGP)
- I VALMCNT=0 D
- . S ^TMP("IBCNR",$J,"SI",1,0)="No Plans Available"
- . S ^TMP("IBCNR",$J,"SI","IDX",1,1)=IBCNGP
- Q
- ;
- SETPLAN(IBCNGP) ;
- ; create text
- N IBGPZ,I,IBPLN,IBPLNA
- S VALMCNT=VALMCNT+1
- S IBGPZ=^IBA(355.3,+IBCNGP,0)
- ; if creating report and not a list
- I $G(IBCNRRPT) D Q
- . ; Group Name, Group #, Group Type, Plan ID, Plan Status
- . ;Get new HIPAA field - IB*2*516/df
- . ;S X=$$FO^IBCNEUT1($P(IBGPZ,U,3),18)
- . ;S X=X_" "_$$FO^IBCNEUT1($P(IBGPZ,U,4),17)
- . S X=$$FO^IBCNEUT1($$GET1^DIQ(355.3,IBCNGP,2.01),18)
- . S X=X_" "_$$FO^IBCNEUT1($$GET1^DIQ(355.3,IBCNGP,2.02),17)
- . S X=X_" "_$$FO^IBCNEUT1($$EXPAND^IBTRE(355.3,.09,$P(IBGPZ,U,9)),13)
- . S IBPLN=$P($G(^IBA(355.3,+IBCNGP,6)),U)
- . ; check for plan
- . I IBPLN="" D Q
- . . S ^TMP("IBCNR",$J,"DSPDATA",VALMCNT)=X
- . . S VALMCNT=VALMCNT+1,^TMP("IBCNR",$J,"DSPDATA",VALMCNT)="No Plan Found."
- . ; check plan status information
- . S IBPLNA=$P($G(^IBCNR(366.03,IBPLN,0)),U)
- . S X=X_" "_$$FO^IBCNEUT1(IBPLNA,13)
- . ;
- . N ARRAY D STCHK^IBCNRU1(IBPLN,.ARRAY)
- . S X=X_" "_$$FO^IBCNEUT1($S($G(ARRAY(1))="I":"INACTIVE",1:"ACTIVE"),8)
- . S ^TMP("IBCNR",$J,"DSPDATA",VALMCNT)=X
- . I $G(ARRAY(6)) D
- . . N STATAR
- . . D STATAR^IBCNRU1(.STATAR)
- . . F I=1:1:$L(ARRAY(6),",") D
- . . . S VALMCNT=VALMCNT+1
- . . . S ^TMP("IBCNR",$J,"DSPDATA",VALMCNT)=" "_$G(STATAR($P(ARRAY(6),",",I)))
- ;
- S X=$$SETFLD^VALM1(VALMCNT,"","NUMBER")
- ;
- I '$P(IBGPZ,U,2) S $E(X,4)="+"
- S X=$$SETFLD^VALM1($$GET1^DIQ(355.3,IBCNGP,2.01),X,"GNAME") ;Get new HIPAA field - IB*2*516
- ;
- I '$P(IBGPZ,U,11) S $E(X,24)="*"
- S X=$$SETFLD^VALM1($$GET1^DIQ(355.3,IBCNGP,2.02),X,"GNUM") ;Get new HIPAA field - IB*2*516
- ;
- S X=$$SETFLD^VALM1($$EXPAND^IBTRE(355.3,.09,$P(IBGPZ,U,9)),X,"TYPE")
- ; matched plan active or not
- S IBPLN=$P($G(^IBA(355.3,+IBCNGP,6)),U)
- I IBPLN'="" D
- . S IBPLNA=$P($G(^IBCNR(366.03,+IBPLN,0)),U)
- . S X=$$SETFLD^VALM1(IBPLNA,X,"PHARM")
- . N ARRAY
- . D STCHK^IBCNRU1(IBPLN,.ARRAY)
- . S X=$$SETFLD^VALM1($S($G(ARRAY(1))="A":"ACTIVE",1:"INACTIVE"),X,"COV")
- S ^TMP("IBCNR",$J,"SI",VALMCNT,0)=X
- S ^TMP("IBCNR",$J,"SI","IDX",VALMCNT,VALMCNT)=IBCNGP
- Q
- ;
- HELP ; -- help code
- S X="?" D DISP^XQORM1 W !!
- Q
- ;
- EXIT ; -- exit code
- K ^TMP("IBCNR",$J),VALMBCK,VALMY
- D CLEAN^VALM10,CLEAR^VALM1
- Q
- ;
- SEL ; -- select plan
- N IBSEL,IBX
- D S1
- I 'IBX Q ; no group selected
- ;
- D
- . N IBCNRRPT,IBCNGP,VALMCNT,LST,IBCNRDEV
- . S VALMCNT=0,IBCNRRPT=1,IBCNRDEV=0,IBCNGP=IBSEL
- . K ^TMP("IBCNR",$J,"DSPDATA")
- . D SETPLAN(IBSEL)
- . D PRINT^IBCNRPSI
- D SPQ
- Q
- S1 ;
- N DIR,DIRUT,DUOUT,DTOUT,DIROUT,IBOK,IBQUIT,Y
- D EN^VALM2($G(XQORNOD(0)),"S"),FULL^VALM1
- S IBX=$O(VALMY(0)),VALMBCK="R"
- ;
- I 'IBX W !!,"No group selected!" G SPQ
- S IBSEL=+$G(^TMP("IBCNR",$J,"SI","IDX",IBX,IBX))
- Q
- ;
- SPQ ;
- I '$O(IBSEL(0)),VALMBCK="R" D PAUSE^VALM1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNRPS2 4982 printed Feb 18, 2025@23:42:51 Page 2
- IBCNRPS2 ;BHAM ISC/ALA - Plan Match ListMan ;13-NOV-2003
- +1 ;;2.0;INTEGRATED BILLING;**276,516**;21-MAR-94;Build 123
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;;
- EN ; -- main entry point for IBCNR PLAN MATCH
- +1 DO EN^VALM("IBCNR PLAN STATUS INQUIRY")
- +2 QUIT
- +3 ;
- HDR ; -- header code
- +1 NEW IBCNS0,IBCNS11,IBCNS13,IBLEAD,X,X1,X2
- +2 SET IBCNS0=$GET(^DIC(36,+IBCNSP,0))
- +3 SET IBCNS11=$GET(^DIC(36,+IBCNSP,.11))
- +4 SET IBCNS13=$GET(^DIC(36,+IBCNSP,.13))
- +5 SET IBLEAD="All Plans for: "
- +6 SET X="Phone: "_$SELECT($PIECE(IBCNS13,"^")]"":$PIECE(IBCNS13,"^"),1:"<not filed>")
- +7 SET VALMHDR(1)=$$SETSTR^VALM1(X,IBLEAD_$PIECE(IBCNS0,"^"),81-$LENGTH(X),40)
- +8 SET X1="Precerts: "_$SELECT($PIECE(IBCNS13,"^",3)]"":$PIECE(IBCNS13,"^",3),1:"<not filed>")
- +9 SET X=$TRANSLATE($JUSTIFY("",$LENGTH(IBLEAD)),""," ")_$SELECT($PIECE(IBCNS11,"^")]"":$PIECE(IBCNS11,"^"),1:"<no street address>")
- +10 SET VALMHDR(2)=$$SETSTR^VALM1(X1,X,81-$LENGTH(X1),40)
- +11 SET X=$SELECT($PIECE(IBCNS11,"^",4)]"":$PIECE(IBCNS11,"^",4),1:"<no city>")_", "
- +12 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:"")
- +13 SET VALMHDR(3)=$$SETSTR^VALM1(X,"",$LENGTH(IBLEAD)+1,80)
- +14 SET X="For: "
- SET X=$EXTRACT(X_$JUSTIFY("",23),1,23)_$SELECT(IBCNTYP="A":"All",IBCNTYP="P":"Pharmacy Covered",1:"Matched")_" Group Plans."
- +15 SET VALMHDR(4)=$$SETSTR^VALM1(" ",X,64,17)
- +16 QUIT
- +17 ;
- INIT ; -- init variables and create list array or report array
- +1 NEW IBGP0,IBCPOLD,X,IBCPD6,IBCNRPP,IBCOV,IBCVRD,LIM
- +2 KILL ^TMP("IBCNR",$JOB)
- +3 SET VALMCNT=0
- SET VALMBG=1
- SET IBCNGP=0
- +4 FOR
- SET IBCNGP=$ORDER(^IBA(355.3,"B",IBCNSP,IBCNGP))
- if 'IBCNGP
- QUIT
- Begin DoDot:1
- +5 ; if we want all plans, let it pass
- +6 IF IBCNTYP="A"
- Begin DoDot:2
- +7 DO SETPLAN(IBCNGP)
- End DoDot:2
- QUIT
- +8 ; if we want Pharmacy plans, check for pharms
- +9 IF IBCNTYP="P"
- Begin DoDot:2
- +10 SET IBCOV=$ORDER(^IBE(355.31,"B","PHARMACY",""))
- +11 SET LIM=""
- SET IBCVRD=0
- +12 FOR
- SET LIM=$ORDER(^IBA(355.32,"B",IBCNGP,LIM))
- if LIM=""
- QUIT
- Begin DoDot:3
- +13 IF $PIECE(^IBA(355.32,LIM,0),U,2)=IBCOV
- SET IBCVRD=$PIECE(^IBA(355.32,LIM,0),U,4)
- End DoDot:3
- +14 IF IBCVRD
- DO SETPLAN(IBCNGP)
- End DoDot:2
- QUIT
- +15 ; if we want Matched plans, check for existence of Plan ID
- +16 IF IBCNTYP="M"
- Begin DoDot:2
- +17 IF $PIECE($GET(^IBA(355.3,IBCNGP,6)),U)'=""
- DO SETPLAN(IBCNGP)
- End DoDot:2
- QUIT
- End DoDot:1
- +18 IF VALMCNT=0
- Begin DoDot:1
- +19 SET ^TMP("IBCNR",$JOB,"SI",1,0)="No Plans Available"
- +20 SET ^TMP("IBCNR",$JOB,"SI","IDX",1,1)=IBCNGP
- End DoDot:1
- +21 QUIT
- +22 ;
- SETPLAN(IBCNGP) ;
- +1 ; create text
- +2 NEW IBGPZ,I,IBPLN,IBPLNA
- +3 SET VALMCNT=VALMCNT+1
- +4 SET IBGPZ=^IBA(355.3,+IBCNGP,0)
- +5 ; if creating report and not a list
- +6 IF $GET(IBCNRRPT)
- Begin DoDot:1
- +7 ; Group Name, Group #, Group Type, Plan ID, Plan Status
- +8 ;Get new HIPAA field - IB*2*516/df
- +9 ;S X=$$FO^IBCNEUT1($P(IBGPZ,U,3),18)
- +10 ;S X=X_" "_$$FO^IBCNEUT1($P(IBGPZ,U,4),17)
- +11 SET X=$$FO^IBCNEUT1($$GET1^DIQ(355.3,IBCNGP,2.01),18)
- +12 SET X=X_" "_$$FO^IBCNEUT1($$GET1^DIQ(355.3,IBCNGP,2.02),17)
- +13 SET X=X_" "_$$FO^IBCNEUT1($$EXPAND^IBTRE(355.3,.09,$PIECE(IBGPZ,U,9)),13)
- +14 SET IBPLN=$PIECE($GET(^IBA(355.3,+IBCNGP,6)),U)
- +15 ; check for plan
- +16 IF IBPLN=""
- Begin DoDot:2
- +17 SET ^TMP("IBCNR",$JOB,"DSPDATA",VALMCNT)=X
- +18 SET VALMCNT=VALMCNT+1
- SET ^TMP("IBCNR",$JOB,"DSPDATA",VALMCNT)="No Plan Found."
- End DoDot:2
- QUIT
- +19 ; check plan status information
- +20 SET IBPLNA=$PIECE($GET(^IBCNR(366.03,IBPLN,0)),U)
- +21 SET X=X_" "_$$FO^IBCNEUT1(IBPLNA,13)
- +22 ;
- +23 NEW ARRAY
- DO STCHK^IBCNRU1(IBPLN,.ARRAY)
- +24 SET X=X_" "_$$FO^IBCNEUT1($SELECT($GET(ARRAY(1))="I":"INACTIVE",1:"ACTIVE"),8)
- +25 SET ^TMP("IBCNR",$JOB,"DSPDATA",VALMCNT)=X
- +26 IF $GET(ARRAY(6))
- Begin DoDot:2
- +27 NEW STATAR
- +28 DO STATAR^IBCNRU1(.STATAR)
- +29 FOR I=1:1:$LENGTH(ARRAY(6),",")
- Begin DoDot:3
- +30 SET VALMCNT=VALMCNT+1
- +31 SET ^TMP("IBCNR",$JOB,"DSPDATA",VALMCNT)=" "_$GET(STATAR($PIECE(ARRAY(6),",",I)))
- End DoDot:3
- End DoDot:2
- End DoDot:1
- QUIT
- +32 ;
- +33 SET X=$$SETFLD^VALM1(VALMCNT,"","NUMBER")
- +34 ;
- +35 IF '$PIECE(IBGPZ,U,2)
- SET $EXTRACT(X,4)="+"
- +36 ;Get new HIPAA field - IB*2*516
- SET X=$$SETFLD^VALM1($$GET1^DIQ(355.3,IBCNGP,2.01),X,"GNAME")
- +37 ;
- +38 IF '$PIECE(IBGPZ,U,11)
- SET $EXTRACT(X,24)="*"
- +39 ;Get new HIPAA field - IB*2*516
- SET X=$$SETFLD^VALM1($$GET1^DIQ(355.3,IBCNGP,2.02),X,"GNUM")
- +40 ;
- +41 SET X=$$SETFLD^VALM1($$EXPAND^IBTRE(355.3,.09,$PIECE(IBGPZ,U,9)),X,"TYPE")
- +42 ; matched plan active or not
- +43 SET IBPLN=$PIECE($GET(^IBA(355.3,+IBCNGP,6)),U)
- +44 IF IBPLN'=""
- Begin DoDot:1
- +45 SET IBPLNA=$PIECE($GET(^IBCNR(366.03,+IBPLN,0)),U)
- +46 SET X=$$SETFLD^VALM1(IBPLNA,X,"PHARM")
- +47 NEW ARRAY
- +48 DO STCHK^IBCNRU1(IBPLN,.ARRAY)
- +49 SET X=$$SETFLD^VALM1($SELECT($GET(ARRAY(1))="A":"ACTIVE",1:"INACTIVE"),X,"COV")
- End DoDot:1
- +50 SET ^TMP("IBCNR",$JOB,"SI",VALMCNT,0)=X
- +51 SET ^TMP("IBCNR",$JOB,"SI","IDX",VALMCNT,VALMCNT)=IBCNGP
- +52 QUIT
- +53 ;
- HELP ; -- help code
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT
- +3 ;
- EXIT ; -- exit code
- +1 KILL ^TMP("IBCNR",$JOB),VALMBCK,VALMY
- +2 DO CLEAN^VALM10
- DO CLEAR^VALM1
- +3 QUIT
- +4 ;
- SEL ; -- select plan
- +1 NEW IBSEL,IBX
- +2 DO S1
- +3 ; no group selected
- IF 'IBX
- QUIT
- +4 ;
- +5 Begin DoDot:1
- +6 NEW IBCNRRPT,IBCNGP,VALMCNT,LST,IBCNRDEV
- +7 SET VALMCNT=0
- SET IBCNRRPT=1
- SET IBCNRDEV=0
- SET IBCNGP=IBSEL
- +8 KILL ^TMP("IBCNR",$JOB,"DSPDATA")
- +9 DO SETPLAN(IBSEL)
- +10 DO PRINT^IBCNRPSI
- End DoDot:1
- +11 DO SPQ
- +12 QUIT
- S1 ;
- +1 NEW DIR,DIRUT,DUOUT,DTOUT,DIROUT,IBOK,IBQUIT,Y
- +2 DO EN^VALM2($GET(XQORNOD(0)),"S")
- DO FULL^VALM1
- +3 SET IBX=$ORDER(VALMY(0))
- SET VALMBCK="R"
- +4 ;
- +5 IF 'IBX
- WRITE !!,"No group selected!"
- GOTO SPQ
- +6 SET IBSEL=+$GET(^TMP("IBCNR",$JOB,"SI","IDX",IBX,IBX))
- +7 QUIT
- +8 ;
- SPQ ;
- +1 IF '$ORDER(IBSEL(0))
- IF VALMBCK="R"
- DO PAUSE^VALM1
- +2 QUIT