source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNRPSM.m@ 1800

IBCNRPSM ;DAOU/CMW - Match Test Payer Sheet to a Pharmacy Plan ;10-DEC-2003
 ;;2.0;INTEGRATED BILLING;**251**;21-MAR-94
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;; ;
EN(IBCNSP)      ; Main entry point for IBCNR PAYERSHEET MATCH (LIST TEMPLATE)
 D EN^VALM("IBCNR PAYERSHEET MATCH")
 Q
 ;
HDR ; Header code
 N IBCNS0,IBCNSID,IBCNSNM,IBCNS10,IBCNSPBM,IBCNSBIN,IBCNSPCN,IBCNS3
 N IBCNSNST,IBCNSLST,IBCNSHDR,X
 S IBCNS0=$G(^IBCNR(366.03,+IBCNSP,0))
 S IBCNSID=$P(IBCNS0,"^",1) ;id
 S IBCNSNM=$P(IBCNS0,"^",2) ;name
 S IBCNS10=$G(^IBCNR(366.03,+IBCNSP,10))
 S IBCNSPBM=$P(IBCNS10,"^",1) ;pbm
 I IBCNSPBM S IBCNSPBM=$P($G(^IBCNR(366.02,+IBCNSPBM,0)),"^",1) ; pbm name
 S IBCNSBIN=$P(IBCNS10,"^",2) ;bin
 S IBCNSPCN=$P(IBCNS10,"^",3) ;pcn
 S IBCNS3=$G(^IBCNR(366.03,+IBCNSP,3,1,0)) ; appl
 S IBCNSNST=$S($P(IBCNS3,"^",2)=0:"Inactive",1:"Active")
 S IBCNSLST=$S($P(IBCNS3,"^",3)=0:"Inactive",1:"Active")
 ; Header Line 1
 S IBCNSHDR="PLAN: "
 S X=IBCNSID_" - "_IBCNSNM
 S VALMHDR(1)=$$SETSTR^VALM1(X,IBCNSHDR,$L(IBCNSHDR)+1,80)
 ; Header Line 2
 S IBCNSHDR="PBM: "_IBCNSPBM
 S X="   BIN: "_IBCNSBIN_"   PCN: "_IBCNSPCN
 S VALMHDR(2)=$$SETSTR^VALM1(X,IBCNSHDR,$L(IBCNSHDR)+1,80)
 ; Header Line 3
 S IBCNSHDR="STATUS: "
 S X="National "_IBCNSNST_"/Local "_IBCNSLST
 S VALMHDR(3)=$$SETSTR^VALM1(X,IBCNSHDR,$L(IBCNSHDR)+1,80)
 Q
 ;
INIT ; Init variables and list array
 N TCODE,IBCNS10,I,TPS,X,NUMBER,PSN
 K ^TMP("IBCNR",$J),TCODE
 S VALMCNT=0,VALMBG=1
 S TCODE(1)="BILLING (B1)"
 S TCODE(2)="REVERSAL (B2)"
 S TCODE(3)="REBILL (B3)"
 S IBCNS10=$G(^IBCNR(366.03,IBCNSP,10))
 F I=1:1:3 S TPS=$P(IBCNS10,"^",10+I) D
 . ; Set up Index Number
 . S VALMCNT=I
 . S X=$$SETFLD^VALM1(VALMCNT,"","NUMBER")
 . ; Set up Transaction code
 . S X=$$SETFLD^VALM1(TCODE(I),X,"TCODE")
 . ; Set up the payer sheet name
 . I $G(TPS) S PSN=$G(^BPSF(9002313.92,TPS,0))
 . I '$G(TPS) S PSN="NOT FOUND"
 . S X=$$SETFLD^VALM1(PSN,X,"PSHEET")
 . ; Set up temporary array
 . S ^TMP("IBCNR",$J,VALMCNT,0)=X
 . S ^TMP("IBCNR",$J,"IDX",VALMCNT,VALMCNT)=IBCNSP
 Q
 ;
HELP ; Help code
 I $D(X),X'["??" D
 . W !,"Possible actions are the following:"
 . S X="?" D DISP^XQORM1,PAUSE^VALM1
 Q
 ;
EXIT ; Exit code
 K ^TMP("IBCNR",$J),VALMY
 D CLEAN^VALM10
 Q
 ;
EXPND ; Expand code
 Q
 ;
SEL ; Add Payer Sheet to Plan
 ; Get the transaction code
 N IBX,IBSEL,IBDR
 D S1
 I 'IBX Q
 ; Get the Payer Sheet Name
 N DIC,Y,X,DTOUT,DUOUT
 N DA,DIE,DR
 S DIC="^BPSF(9002313.92,",DIC(0)="AEMZ",DIC("S")="I $P(^(1),U,6)=2"
 D ^DIC
 I +Y<1 W !!,"No Payer Sheet Selected!" D PAUSE^VALM1 Q
 ; Do the insert
 S DA=IBSEL,DIE="^IBCNR(366.03,",DR=IBDR_"////^S X="_+Y
 D ^DIE
 ; Rebuild ListMan screen data
 D INIT
 Q
 ;
DEL ; Delete Payer Sheet from Plan
 ; Get the transaction code
 N IBX,IBSEL,IBDR
 D S1
 I 'IBX Q
 ; Do the deletion
 N DA,DIE,DR
 S DA=IBSEL,DIE="^IBCNR(366.03,",DR=IBDR_"///@"
 D ^DIE
 ; Rebuild ListMan screen data
 D INIT
 Q
 ;
S1 ; Prompt for transaction code
 N VALMY
 D FULL^VALM1,EN^VALM2($G(XQORNOD(0)),"S")
 ; Store transaction code in IBX
 S IBX=$O(VALMY(0))
 ; Set variable to refresh the screen when returning from the action
 S VALMBCK="R"
 ; Display error if not transaction code was picked and exit
 I 'IBX W !!,"No Transaction Code Selected!" D PAUSE^VALM1 Q
 ; Build variables needed for insert or deletion
 S IBSEL=+$G(^TMP("IBCNR",$J,"IDX",IBX,IBX))
 S IBDR=$S(IBX=1:10.11,IBX=2:10.12,1:10.13)
 Q