| [613] | 1 | IBCNRPSM ;DAOU/CMW - Match Test Payer Sheet to a Pharmacy Plan ;10-DEC-2003
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**251**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;; ;
|
|---|
| 5 | EN(IBCNSP) ; Main entry point for IBCNR PAYERSHEET MATCH (LIST TEMPLATE)
|
|---|
| 6 | D EN^VALM("IBCNR PAYERSHEET MATCH")
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | HDR ; Header code
|
|---|
| 10 | N IBCNS0,IBCNSID,IBCNSNM,IBCNS10,IBCNSPBM,IBCNSBIN,IBCNSPCN,IBCNS3
|
|---|
| 11 | N IBCNSNST,IBCNSLST,IBCNSHDR,X
|
|---|
| 12 | S IBCNS0=$G(^IBCNR(366.03,+IBCNSP,0))
|
|---|
| 13 | S IBCNSID=$P(IBCNS0,"^",1) ;id
|
|---|
| 14 | S IBCNSNM=$P(IBCNS0,"^",2) ;name
|
|---|
| 15 | S IBCNS10=$G(^IBCNR(366.03,+IBCNSP,10))
|
|---|
| 16 | S IBCNSPBM=$P(IBCNS10,"^",1) ;pbm
|
|---|
| 17 | I IBCNSPBM S IBCNSPBM=$P($G(^IBCNR(366.02,+IBCNSPBM,0)),"^",1) ; pbm name
|
|---|
| 18 | S IBCNSBIN=$P(IBCNS10,"^",2) ;bin
|
|---|
| 19 | S IBCNSPCN=$P(IBCNS10,"^",3) ;pcn
|
|---|
| 20 | S IBCNS3=$G(^IBCNR(366.03,+IBCNSP,3,1,0)) ; appl
|
|---|
| 21 | S IBCNSNST=$S($P(IBCNS3,"^",2)=0:"Inactive",1:"Active")
|
|---|
| 22 | S IBCNSLST=$S($P(IBCNS3,"^",3)=0:"Inactive",1:"Active")
|
|---|
| 23 | ; Header Line 1
|
|---|
| 24 | S IBCNSHDR="PLAN: "
|
|---|
| 25 | S X=IBCNSID_" - "_IBCNSNM
|
|---|
| 26 | S VALMHDR(1)=$$SETSTR^VALM1(X,IBCNSHDR,$L(IBCNSHDR)+1,80)
|
|---|
| 27 | ; Header Line 2
|
|---|
| 28 | S IBCNSHDR="PBM: "_IBCNSPBM
|
|---|
| 29 | S X=" BIN: "_IBCNSBIN_" PCN: "_IBCNSPCN
|
|---|
| 30 | S VALMHDR(2)=$$SETSTR^VALM1(X,IBCNSHDR,$L(IBCNSHDR)+1,80)
|
|---|
| 31 | ; Header Line 3
|
|---|
| 32 | S IBCNSHDR="STATUS: "
|
|---|
| 33 | S X="National "_IBCNSNST_"/Local "_IBCNSLST
|
|---|
| 34 | S VALMHDR(3)=$$SETSTR^VALM1(X,IBCNSHDR,$L(IBCNSHDR)+1,80)
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | INIT ; Init variables and list array
|
|---|
| 38 | N TCODE,IBCNS10,I,TPS,X,NUMBER,PSN
|
|---|
| 39 | K ^TMP("IBCNR",$J),TCODE
|
|---|
| 40 | S VALMCNT=0,VALMBG=1
|
|---|
| 41 | S TCODE(1)="BILLING (B1)"
|
|---|
| 42 | S TCODE(2)="REVERSAL (B2)"
|
|---|
| 43 | S TCODE(3)="REBILL (B3)"
|
|---|
| 44 | S IBCNS10=$G(^IBCNR(366.03,IBCNSP,10))
|
|---|
| 45 | F I=1:1:3 S TPS=$P(IBCNS10,"^",10+I) D
|
|---|
| 46 | . ; Set up Index Number
|
|---|
| 47 | . S VALMCNT=I
|
|---|
| 48 | . S X=$$SETFLD^VALM1(VALMCNT,"","NUMBER")
|
|---|
| 49 | . ; Set up Transaction code
|
|---|
| 50 | . S X=$$SETFLD^VALM1(TCODE(I),X,"TCODE")
|
|---|
| 51 | . ; Set up the payer sheet name
|
|---|
| 52 | . I $G(TPS) S PSN=$G(^BPSF(9002313.92,TPS,0))
|
|---|
| 53 | . I '$G(TPS) S PSN="NOT FOUND"
|
|---|
| 54 | . S X=$$SETFLD^VALM1(PSN,X,"PSHEET")
|
|---|
| 55 | . ; Set up temporary array
|
|---|
| 56 | . S ^TMP("IBCNR",$J,VALMCNT,0)=X
|
|---|
| 57 | . S ^TMP("IBCNR",$J,"IDX",VALMCNT,VALMCNT)=IBCNSP
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | HELP ; Help code
|
|---|
| 61 | I $D(X),X'["??" D
|
|---|
| 62 | . W !,"Possible actions are the following:"
|
|---|
| 63 | . S X="?" D DISP^XQORM1,PAUSE^VALM1
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | EXIT ; Exit code
|
|---|
| 67 | K ^TMP("IBCNR",$J),VALMY
|
|---|
| 68 | D CLEAN^VALM10
|
|---|
| 69 | Q
|
|---|
| 70 | ;
|
|---|
| 71 | EXPND ; Expand code
|
|---|
| 72 | Q
|
|---|
| 73 | ;
|
|---|
| 74 | SEL ; Add Payer Sheet to Plan
|
|---|
| 75 | ; Get the transaction code
|
|---|
| 76 | N IBX,IBSEL,IBDR
|
|---|
| 77 | D S1
|
|---|
| 78 | I 'IBX Q
|
|---|
| 79 | ; Get the Payer Sheet Name
|
|---|
| 80 | N DIC,Y,X,DTOUT,DUOUT
|
|---|
| 81 | N DA,DIE,DR
|
|---|
| 82 | S DIC="^BPSF(9002313.92,",DIC(0)="AEMZ",DIC("S")="I $P(^(1),U,6)=2"
|
|---|
| 83 | D ^DIC
|
|---|
| 84 | I +Y<1 W !!,"No Payer Sheet Selected!" D PAUSE^VALM1 Q
|
|---|
| 85 | ; Do the insert
|
|---|
| 86 | S DA=IBSEL,DIE="^IBCNR(366.03,",DR=IBDR_"////^S X="_+Y
|
|---|
| 87 | D ^DIE
|
|---|
| 88 | ; Rebuild ListMan screen data
|
|---|
| 89 | D INIT
|
|---|
| 90 | Q
|
|---|
| 91 | ;
|
|---|
| 92 | DEL ; Delete Payer Sheet from Plan
|
|---|
| 93 | ; Get the transaction code
|
|---|
| 94 | N IBX,IBSEL,IBDR
|
|---|
| 95 | D S1
|
|---|
| 96 | I 'IBX Q
|
|---|
| 97 | ; Do the deletion
|
|---|
| 98 | N DA,DIE,DR
|
|---|
| 99 | S DA=IBSEL,DIE="^IBCNR(366.03,",DR=IBDR_"///@"
|
|---|
| 100 | D ^DIE
|
|---|
| 101 | ; Rebuild ListMan screen data
|
|---|
| 102 | D INIT
|
|---|
| 103 | Q
|
|---|
| 104 | ;
|
|---|
| 105 | S1 ; Prompt for transaction code
|
|---|
| 106 | N VALMY
|
|---|
| 107 | D FULL^VALM1,EN^VALM2($G(XQORNOD(0)),"S")
|
|---|
| 108 | ; Store transaction code in IBX
|
|---|
| 109 | S IBX=$O(VALMY(0))
|
|---|
| 110 | ; Set variable to refresh the screen when returning from the action
|
|---|
| 111 | S VALMBCK="R"
|
|---|
| 112 | ; Display error if not transaction code was picked and exit
|
|---|
| 113 | I 'IBX W !!,"No Transaction Code Selected!" D PAUSE^VALM1 Q
|
|---|
| 114 | ; Build variables needed for insert or deletion
|
|---|
| 115 | S IBSEL=+$G(^TMP("IBCNR",$J,"IDX",IBX,IBX))
|
|---|
| 116 | S IBDR=$S(IBX=1:10.11,IBX=2:10.12,1:10.13)
|
|---|
| 117 | Q
|
|---|
