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

IBCNRP.m

Go to the documentation of this file.
  1. IBCNRP ;DAOU/ALA - Plan Match ListMan ;13-NOV-2003
  1. ;;2.0;INTEGRATED BILLING;**251,516,550,617**;21-MAR-94;Build 43
  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 MATCH")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. NEW 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 X2=$S(IBW:"",1:"Active ")
  1. S IBLEAD=$S(IBIND:"All "_X2,1:X2_"Group ")_"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="#" I $G(IBIND) S X="# + => Indiv. Plan"
  1. I $G(IBW) S X=$E(X_$J("",23),1,23)_"* => Inactive Plan"
  1. S VALMHDR(4)=$$SETSTR^VALM1(" ",X,64,17)
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. NEW IBCNRPP,IBCOV,IBCPD6,IBCPOLD,IBCRVD,IBMDTE,IBMUSR,LIM,X
  1. K ^TMP("IBCNR",$J)
  1. S VALMCNT=0,VALMBG=1
  1. S VALMCNT1=0
  1. ; MRD;IB*2.0*516 - Rather than pull the zero node here, use $$GET1^DIQ
  1. ; to pull specific pieces down below.
  1. ;S IBGP0=^IBA(355.3,+IBCNGP,0)
  1. ;I $G(IBGP0) D
  1. I $G(^IBA(355.3,+IBCNGP,0)) D
  1. . ;S IBCPD6=$G(IBGP0,U,6)) ;chk pre-cert
  1. . ;I 'IBIND,'$P(IBGP0,"^",2) Q ; exclude individual plans
  1. . ;I 'IBW,$P(IBGP0,"^",11) Q ; plan is inactive
  1. . ;
  1. . S VALMCNT=VALMCNT+1
  1. . S VALMCNT1=VALMCNT1+1
  1. . S X=$$SETFLD^VALM1(VALMCNT1,"","NUMBER")
  1. . ;
  1. . ;I '$P(IBGP0,"^",2) S $E(X,4)="+"
  1. . ;S X=$$SETFLD^VALM1($P(IBGP0,"^",3),X,"GNAME")
  1. . I '$$GET1^DIQ(355.3,+IBCNGP_",",.02,"I") S $E(X,4)="+"
  1. . S X=$$SETFLD^VALM1($$GET1^DIQ(355.3,+IBCNGP_",",2.01),X,"GNAME")
  1. . ;
  1. . ;I $P(IBGP0,"^",11) S $E(X,24)="*"
  1. . ;S X=$$SETFLD^VALM1($P(IBGP0,"^",4),X,"GNUM")
  1. . I $$GET1^DIQ(355.3,+IBCNGP_",",.11,"I") S $E(X,24)="*"
  1. . S X=$$SETFLD^VALM1($$GET1^DIQ(355.3,+IBCNGP_",",2.02),X,"GNUM")
  1. . ;
  1. . ;S X=$$SETFLD^VALM1($$EXPAND^IBTRE(355.3,.09,$P(IBGP0,"^",9)),X,"TYPE")
  1. . S X=$$SETFLD^VALM1($$GET1^DIQ(355.3,+IBCNGP_",",.09,"E"),X,"TYPE")
  1. . ;
  1. . S IBCNRPP=$$GET1^DIQ(355.3,IBCNGP_",",6.01,"I")
  1. . I IBCNRPP'="" S IBCNRPP=$$GET1^DIQ(366.03,IBCNRPP_",",.01,"E")
  1. . S X=$$SETFLD^VALM1(IBCNRPP,X,"PHARM")
  1. . ;
  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. . S X=$$SETFLD^VALM1($S(IBCVRD=0:"NO",1:"YES"),X,"COV")
  1. . ;
  1. . S ^TMP("IBCNR",$J,VALMCNT,0)=X
  1. . S ^TMP("IBCNR",$J,"IDX",VALMCNT,VALMCNT1)=IBCNGP
  1. . S ^TMP("IBCNR",$J,"IDX1",VALMCNT1)=IBCNGP
  1. . ;
  1. . I IBCNRPP'="" D ; If VA PLAN ID exists
  1. . . S IBMDTE=$$GET1^DIQ(355.3,IBCNGP_",",1.07,"E")
  1. . . S IBMUSR=$$GET1^DIQ(355.3,IBCNGP_",",1.08,"E")
  1. . . I IBMDTE'="" D ; If DATE LAST MATCHED exists
  1. . . . S X=" Matched by: "_IBMUSR_" "_IBMDTE
  1. . . . S VALMCNT=VALMCNT+1
  1. . . . S ^TMP("IBCNR",$J,VALMCNT,0)=X
  1. . . . S ^TMP("IBCNR",$J,"IDX",VALMCNT,VALMCNT1)=IBCNGP
  1. . . . S ^TMP("IBCNR",$J,"IDX1",VALMCNT1)=IBCNGP
  1. . I IBCNRPP="" D ; If VA PLAN ID does not exist
  1. . . S IBMDTE=$$GET1^DIQ(355.3,IBCNGP_",",1.07,"E")
  1. . . S IBMUSR=$$GET1^DIQ(355.3,IBCNGP_",",1.08,"E")
  1. . . I IBMDTE'="" D ; Match Date w/no Plan ID means Deleted
  1. . . . S X=" Deleted by: "_IBMUSR_" "_IBMDTE
  1. . . . S VALMCNT=VALMCNT+1
  1. . . . S ^TMP("IBCNR",$J,VALMCNT,0)=X
  1. . . . S ^TMP("IBCNR",$J,"IDX",VALMCNT,VALMCNT1)=IBCNGP
  1. . . . S ^TMP("IBCNR",$J,"IDX1",VALMCNT1)=IBCNGP
  1. . ;
  1. . I '$D(^TMP("IBCNR",$J)) S VALMCNT=2,^TMP("IBCNR",$J,1,0)=" ",^TMP("IBCNR",$J,2,0)=" No plans were identified for this company."
  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. EXPND ; -- expand code
  1. Q
  1. ;
  1. SEL ; -- select plan
  1. D S1
  1. I 'IBX Q ; no group selected
  1. ;
  1. NEW DA,DIC,DIE,DR,D,IBPLN,IBPLNOLD,IBUSROLD
  1. S DIC="^IBCNR(366.03,",DIC(0)="AEMNZ" D ^DIC
  1. I +Y<1 S D="F" D IX^DIC
  1. I +Y<1 G SPQ
  1. S IBPLN=+Y K Y,X
  1. D PLCK ; check plan status
  1. S IBPLNOLD=$$GET1^DIQ(355.3,IBCNGP,6.01,"I")
  1. S IBUSROLD=$$GET1^DIQ(355.3,IBCNGP,1.08)
  1. S DA=IBSEL,DIC="^IBA(355.3,",DIE=DIC,DR="6.01////^S X="_IBPLN
  1. I IBPLNOLD'=IBPLN S DR=DR_";1.07///NOW;1.08////"_DUZ
  1. I IBPLNOLD=IBPLN,IBUSROLD="" S DR=DR_";1.07///NOW;1.08////"_DUZ
  1. D ^DIE
  1. D INIT
  1. ;
  1. S IBX=0 F S IBX=$O(VALMY(IBX)) Q:'IBX S ^TMP($J,"IBSEL",+$G(^TMP("IBCNR",$J,"IDX",IBX,IBX)))=""
  1. ;
  1. D SPQ
  1. Q
  1. ;
  1. PLCK ; -- check plan status
  1. NEW ARRAY
  1. D STCHK^IBCNRU1(IBPLN,.ARRAY)
  1. I $G(ARRAY(1))'="A" D
  1. . W !!,"WARNING....PLAN NOT ACTIVE!"
  1. ;
  1. Q
  1. ;
  1. DEL ; -- remove a plan from a group
  1. D S1
  1. ;
  1. NEW DA,DIC,DIE,DR,IBPLNOLD
  1. S IBPLNOLD=$$GET1^DIQ(355.3,IBCNGP,6.01,"I")
  1. S DA=IBSEL,DIC="^IBA(355.3,",DIE=DIC,DR="6.01///@"
  1. I IBPLNOLD'="" S DR=DR_";1.07///NOW;1.08////"_DUZ
  1. D ^DIE
  1. D INIT
  1. ;
  1. S IBX=0 F S IBX=$O(VALMY(IBX)) Q:'IBX S ^TMP($J,"IBSEL",+$G(^TMP("IBCNR",$J,"IDX",IBX,IBX)))=""
  1. ;
  1. D SPQ
  1. Q
  1. ;
  1. S1 ;
  1. NEW 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. I 'IBMULT D G SPQ
  1. . I $O(VALMY(IBX)) W !!,*7,"You may only select a single plan!" Q
  1. . I $G(IBALR),+$G(^TMP("IBCNR",$J,"IDX",IBX,IBX))=IBALR W !!,*7,"This plan is not allowed for selection!" Q
  1. . D OK^IBCNSM3
  1. . I IBQUIT S VALMBCK="Q" Q
  1. . ;I IBOK S IBSEL=+$G(^TMP("IBCNR",$J,"IDX",IBX,IBX)),VALMBCK="Q"
  1. . I IBOK S IBSEL=+$G(^TMP("IBCNR",$J,"IDX1",IBX)),VALMBCK="Q"
  1. ;
  1. ;S IBSEL=+$G(^TMP("IBCNR",$J,"IDX",IBX,IBX))
  1. S IBSEL=+$G(^TMP("IBCNR",$J,"IDX1",IBX))
  1. Q
  1. ;
  1. SPQ ;
  1. I '$O(IBSEL(0)),VALMBCK="R" D PAUSE^VALM1
  1. Q