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

IBCNRPS2.m

Go to the documentation of this file.
  1. IBCNRPS2 ;BHAM ISC/ALA - Plan Match ListMan ;13-NOV-2003
  1. ;;2.0;INTEGRATED BILLING;**276,516**;21-MAR-94;Build 123
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;
  1. EN ; -- main entry point for IBCNR PLAN MATCH
  1. D EN^VALM("IBCNR PLAN STATUS INQUIRY")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. N IBCNS0,IBCNS11,IBCNS13,IBLEAD,X,X1,X2
  1. S IBCNS0=$G(^DIC(36,+IBCNSP,0))
  1. S IBCNS11=$G(^DIC(36,+IBCNSP,.11))
  1. S IBCNS13=$G(^DIC(36,+IBCNSP,.13))
  1. S IBLEAD="All Plans for: "
  1. S X="Phone: "_$S($P(IBCNS13,"^")]"":$P(IBCNS13,"^"),1:"<not filed>")
  1. S VALMHDR(1)=$$SETSTR^VALM1(X,IBLEAD_$P(IBCNS0,"^"),81-$L(X),40)
  1. S X1="Precerts: "_$S($P(IBCNS13,"^",3)]"":$P(IBCNS13,"^",3),1:"<not filed>")
  1. S X=$TR($J("",$L(IBLEAD)),""," ")_$S($P(IBCNS11,"^")]"":$P(IBCNS11,"^"),1:"<no street address>")
  1. S VALMHDR(2)=$$SETSTR^VALM1(X1,X,81-$L(X1),40)
  1. S X=$S($P(IBCNS11,"^",4)]"":$P(IBCNS11,"^",4),1:"<no city>")_", "
  1. 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:"")
  1. S VALMHDR(3)=$$SETSTR^VALM1(X,"",$L(IBLEAD)+1,80)
  1. S X="For: ",X=$E(X_$J("",23),1,23)_$S(IBCNTYP="A":"All",IBCNTYP="P":"Pharmacy Covered",1:"Matched")_" Group Plans."
  1. S VALMHDR(4)=$$SETSTR^VALM1(" ",X,64,17)
  1. Q
  1. ;
  1. INIT ; -- init variables and create list array or report array
  1. N IBGP0,IBCPOLD,X,IBCPD6,IBCNRPP,IBCOV,IBCVRD,LIM
  1. K ^TMP("IBCNR",$J)
  1. S VALMCNT=0,VALMBG=1,IBCNGP=0
  1. F S IBCNGP=$O(^IBA(355.3,"B",IBCNSP,IBCNGP)) Q:'IBCNGP D
  1. . ; if we want all plans, let it pass
  1. . I IBCNTYP="A" D Q
  1. . . D SETPLAN(IBCNGP)
  1. . ; if we want Pharmacy plans, check for pharms
  1. . I IBCNTYP="P" D Q
  1. . . S IBCOV=$O(^IBE(355.31,"B","PHARMACY",""))
  1. . . S LIM="",IBCVRD=0
  1. . . F S LIM=$O(^IBA(355.32,"B",IBCNGP,LIM)) Q:LIM="" D
  1. . . . I $P(^IBA(355.32,LIM,0),U,2)=IBCOV S IBCVRD=$P(^IBA(355.32,LIM,0),U,4)
  1. . . I IBCVRD D SETPLAN(IBCNGP)
  1. . ; if we want Matched plans, check for existence of Plan ID
  1. . I IBCNTYP="M" D Q
  1. . . I $P($G(^IBA(355.3,IBCNGP,6)),U)'="" D SETPLAN(IBCNGP)
  1. I VALMCNT=0 D
  1. . S ^TMP("IBCNR",$J,"SI",1,0)="No Plans Available"
  1. . S ^TMP("IBCNR",$J,"SI","IDX",1,1)=IBCNGP
  1. Q
  1. ;
  1. SETPLAN(IBCNGP) ;
  1. ; create text
  1. N IBGPZ,I,IBPLN,IBPLNA
  1. S VALMCNT=VALMCNT+1
  1. S IBGPZ=^IBA(355.3,+IBCNGP,0)
  1. ; if creating report and not a list
  1. I $G(IBCNRRPT) D Q
  1. . ; Group Name, Group #, Group Type, Plan ID, Plan Status
  1. . ;Get new HIPAA field - IB*2*516/df
  1. . ;S X=$$FO^IBCNEUT1($P(IBGPZ,U,3),18)
  1. . ;S X=X_" "_$$FO^IBCNEUT1($P(IBGPZ,U,4),17)
  1. . S X=$$FO^IBCNEUT1($$GET1^DIQ(355.3,IBCNGP,2.01),18)
  1. . S X=X_" "_$$FO^IBCNEUT1($$GET1^DIQ(355.3,IBCNGP,2.02),17)
  1. . S X=X_" "_$$FO^IBCNEUT1($$EXPAND^IBTRE(355.3,.09,$P(IBGPZ,U,9)),13)
  1. . S IBPLN=$P($G(^IBA(355.3,+IBCNGP,6)),U)
  1. . ; check for plan
  1. . I IBPLN="" D Q
  1. . . S ^TMP("IBCNR",$J,"DSPDATA",VALMCNT)=X
  1. . . S VALMCNT=VALMCNT+1,^TMP("IBCNR",$J,"DSPDATA",VALMCNT)="No Plan Found."
  1. . ; check plan status information
  1. . S IBPLNA=$P($G(^IBCNR(366.03,IBPLN,0)),U)
  1. . S X=X_" "_$$FO^IBCNEUT1(IBPLNA,13)
  1. . ;
  1. . N ARRAY D STCHK^IBCNRU1(IBPLN,.ARRAY)
  1. . S X=X_" "_$$FO^IBCNEUT1($S($G(ARRAY(1))="I":"INACTIVE",1:"ACTIVE"),8)
  1. . S ^TMP("IBCNR",$J,"DSPDATA",VALMCNT)=X
  1. . I $G(ARRAY(6)) D
  1. . . N STATAR
  1. . . D STATAR^IBCNRU1(.STATAR)
  1. . . F I=1:1:$L(ARRAY(6),",") D
  1. . . . S VALMCNT=VALMCNT+1
  1. . . . S ^TMP("IBCNR",$J,"DSPDATA",VALMCNT)=" "_$G(STATAR($P(ARRAY(6),",",I)))
  1. ;
  1. S X=$$SETFLD^VALM1(VALMCNT,"","NUMBER")
  1. ;
  1. I '$P(IBGPZ,U,2) S $E(X,4)="+"
  1. S X=$$SETFLD^VALM1($$GET1^DIQ(355.3,IBCNGP,2.01),X,"GNAME") ;Get new HIPAA field - IB*2*516
  1. ;
  1. I '$P(IBGPZ,U,11) S $E(X,24)="*"
  1. S X=$$SETFLD^VALM1($$GET1^DIQ(355.3,IBCNGP,2.02),X,"GNUM") ;Get new HIPAA field - IB*2*516
  1. ;
  1. S X=$$SETFLD^VALM1($$EXPAND^IBTRE(355.3,.09,$P(IBGPZ,U,9)),X,"TYPE")
  1. ; matched plan active or not
  1. S IBPLN=$P($G(^IBA(355.3,+IBCNGP,6)),U)
  1. I IBPLN'="" D
  1. . S IBPLNA=$P($G(^IBCNR(366.03,+IBPLN,0)),U)
  1. . S X=$$SETFLD^VALM1(IBPLNA,X,"PHARM")
  1. . N ARRAY
  1. . D STCHK^IBCNRU1(IBPLN,.ARRAY)
  1. . S X=$$SETFLD^VALM1($S($G(ARRAY(1))="A":"ACTIVE",1:"INACTIVE"),X,"COV")
  1. S ^TMP("IBCNR",$J,"SI",VALMCNT,0)=X
  1. S ^TMP("IBCNR",$J,"SI","IDX",VALMCNT,VALMCNT)=IBCNGP
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. K ^TMP("IBCNR",$J),VALMBCK,VALMY
  1. D CLEAN^VALM10,CLEAR^VALM1
  1. Q
  1. ;
  1. SEL ; -- select plan
  1. N IBSEL,IBX
  1. D S1
  1. I 'IBX Q ; no group selected
  1. ;
  1. D
  1. . N IBCNRRPT,IBCNGP,VALMCNT,LST,IBCNRDEV
  1. . S VALMCNT=0,IBCNRRPT=1,IBCNRDEV=0,IBCNGP=IBSEL
  1. . K ^TMP("IBCNR",$J,"DSPDATA")
  1. . D SETPLAN(IBSEL)
  1. . D PRINT^IBCNRPSI
  1. D SPQ
  1. Q
  1. S1 ;
  1. N DIR,DIRUT,DUOUT,DTOUT,DIROUT,IBOK,IBQUIT,Y
  1. D EN^VALM2($G(XQORNOD(0)),"S"),FULL^VALM1
  1. S IBX=$O(VALMY(0)),VALMBCK="R"
  1. ;
  1. I 'IBX W !!,"No group selected!" G SPQ
  1. S IBSEL=+$G(^TMP("IBCNR",$J,"SI","IDX",IBX,IBX))
  1. Q
  1. ;
  1. SPQ ;
  1. I '$O(IBSEL(0)),VALMBCK="R" D PAUSE^VALM1
  1. Q