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

Last change on this file since 1093 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1IBCNRPSM ;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 ;; ;
5EN(IBCNSP) ; Main entry point for IBCNR PAYERSHEET MATCH (LIST TEMPLATE)
6 D EN^VALM("IBCNR PAYERSHEET MATCH")
7 Q
8 ;
9HDR ; 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 ;
37INIT ; 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 ;
60HELP ; 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 ;
66EXIT ; Exit code
67 K ^TMP("IBCNR",$J),VALMY
68 D CLEAN^VALM10
69 Q
70 ;
71EXPND ; Expand code
72 Q
73 ;
74SEL ; 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 ;
92DEL ; 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 ;
105S1 ; 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
Note: See TracBrowser for help on using the repository browser.