- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNEBF.m
r613 r623 1 IBCNEBF ;DAOU/ALA - Create an Entry in the Buffer File ;20-JUN-2002 2 ;;2.0;INTEGRATED BILLING;**184,271,361,371**;21-MAR-94;Build 57 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;**Program Description** 6 ; This program will create a Buffer entry based upon input values 7 ; 8 Q 9 ; 10 PT(DFN,IRIEN,SYMBOL,OVRRIDE,ADD,IBERROR) ; Get data 11 ; from a specific patient and insurance record entry 12 ; 13 ; Input Parameters 14 ; DFN = Patient IEN 15 ; IRIEN = Patient Insurance Record IEN 16 ; SYMBOL = IIV Symbol IEN 17 ; OVRRIDE = Override flag for ins. buffer record (0 or 1) 18 ; ADD = If defined, then it will add a new Buffer entry 19 ; IBERROR = If defined, then it will be updated with error info. 20 ; OPTIONALLY PASSED BY REFERENCE 21 ; 22 I DFN=""!(IRIEN="") Q ; * do not require SYMBOL or OVRRIDE 23 ; 24 ; 25 NEW VBUF,IEN,INAME,PNAME,IIEN,GNUMB,GNAME,SUBID,PPHONE,PATID 26 NEW BPHONE,EFFDT,EXPDT,WHO,REL,IDOB,ISSN,COB,TQIEN,RDATA,ISEX,NAME 27 NEW MSG,XMSUB,MSGP,INSDATA,PCE,BFD,BFN,INSPCE,ESGHPARR 28 ; 29 S IIEN=$P($G(^DPT(DFN,.312,IRIEN,0)),U,1) 30 S INAME=$$GET1^DIQ(36,IIEN,.01,"E") 31 S PPHONE=$P($G(^DIC(36,IIEN,.13)),U,3) 32 S BPHONE=$P($G(^DIC(36,IIEN,.13)),U,2) 33 S NAME=$P($G(^DPT(DFN,.312,IRIEN,0)),U,17) 34 S SUBID=$P($G(^DPT(DFN,.312,IRIEN,0)),U,2) 35 S PATID=$P($G(^DPT(DFN,.312,IRIEN,5)),U,1) 36 S WHO=$P($G(^DPT(DFN,.312,IRIEN,0)),U,6) 37 S COB=$P($G(^DPT(DFN,.312,IRIEN,0)),U,20) 38 S IDOB=$P($G(^DPT(DFN,.312,IRIEN,3)),U,1) 39 S ISSN=$P($G(^DPT(DFN,.312,IRIEN,3)),U,5) 40 S ISEX=$P($G(^DPT(DFN,.312,IRIEN,3)),U,12) 41 S EFFDT=$P(^DPT(DFN,.312,IRIEN,0),U,8) 42 S EXPDT=$P(^DPT(DFN,.312,IRIEN,0),U,4) 43 S REL=$P(^DPT(DFN,.312,IRIEN,0),U,16) 44 ; 45 S IENS=IRIEN_","_DFN_"," 46 S GNUMB=$$GET1^DIQ(2.312,IENS,21,"E") 47 S GNAME=$$GET1^DIQ(2.312,IENS,20,"E") 48 ; 49 ; Capture the employer sponsored insurance fields into array 50 ; ESGHPARR(buffer field number) = data 51 ; 52 S INSDATA=$G(^DPT(DFN,.312,IRIEN,2)),PCE=0 53 F BFD=5:1:12,2,1,3,4 S PCE=PCE+1,BFN=BFD/100+61,INSPCE=$P(INSDATA,U,PCE) I INSPCE'="" S ESGHPARR(BFN)=INSPCE 54 ; 55 D FIL 56 K ADD 57 Q 58 ; 59 RP(IEN,ADD,BUFF) ; Get data from a specific response record 60 ; 61 ; Input Parameter 62 ; IEN = Internal entry number of the Response 63 ; ADD = If defined, then it will add a new Buffer entry 64 ; BUFF = IEN of the Buffer Entry to be updated (optional) 65 ; 66 S BUFF=$G(BUFF) ; Initialize optional parameter 67 ; 68 NEW PIEN,RSTYPE 69 S DFN=$P(^IBCN(365,IEN,0),U,2),TQIEN=$P(^IBCN(365,IEN,0),U,5) 70 S PIEN=$P(^IBCN(365,IEN,0),U,3),RSTYPE=$P(^(0),U,10) 71 I PIEN'="" S PNAME=$P(^IBE(365.12,PIEN,0),U,1) 72 I TQIEN'="" S IRIEN=$P($G(^IBCN(365.1,TQIEN,0)),U,13) 73 I $G(IRIEN)'="" S INAME="" D 74 . S IIEN=$P($G(^DPT(DFN,.312,IRIEN,0)),U,1) 75 . I IIEN="" Q 76 . S INAME=$P(^DIC(36,IIEN,0),U,1) 77 S RDATA=$G(^IBCN(365,IEN,1)) 78 S NAME=$P(RDATA,U,1) 79 S INAME=$S($G(INAME)'=""&(RSTYPE="O"):INAME,1:$G(PNAME)) 80 S IDOB=$P(RDATA,U,2) 81 S ISSN=$P(RDATA,U,3) 82 S ISEX=$P(RDATA,U,4) 83 S COB=$P(RDATA,U,13) 84 S SUBID=$P(RDATA,U,5) 85 S PATID=$P(RDATA,U,18) 86 S GNAME=$P(RDATA,U,6) 87 S GNUMB=$P(RDATA,U,7) 88 S WHO=$P(RDATA,U,8) 89 S REL=$P(RDATA,U,9) 90 S EFFDT=$P(RDATA,U,11) 91 S EXPDT=$P(RDATA,U,12) 92 S PPHONE="",BPHONE="" 93 ; 94 D FIL 95 K DFN,VBUF,IEN,IRIEN,INAME,PNAME,IIEN,GNUMB,GNAME,SUBID,PPHONE,PATID 96 K BPHONE,EFFDT,EXPDT,WHO,REL,IDOB,ISSN,COB,TQIEN,RDATA,ISEX,NAME 97 K ADD,%DT,D0,DG,DIC,DISYS,DIW,IENS 98 Q 99 ; 100 FIL ; File Buffer Data 101 ; 102 S MSGP=$$MGRP^IBCNEUT5() 103 ; 104 ; Variable IDUZ is optionally set by the calling routine. If it is 105 ; not defined, it will be set to the specific, non-human user. 106 ; 107 I $G(IDUZ)="" S IDUZ=$$FIND1^DIC(200,"","X","INTERFACE,IB IIV") 108 ; 109 I $G(ADD) S VBUF(.02)=IDUZ ; Entered By 110 S VBUF(.12)=$G(SYMBOL) ; Buffer Symbol 111 S VBUF(.13)=$G(OVRRIDE) ; Override freshness flag 112 I '$G(ERACT) D ; Only file if not an error 113 . S VBUF(20.01)=INAME ; Insurance Company/Payer Name 114 . S VBUF(60.01)=DFN ; Patient IEN 115 . S VBUF(40.03)=GNUMB ; Group Number 116 . S VBUF(40.02)=GNAME ; Group Name 117 . S VBUF(60.07)=NAME ; Name of Insured 118 . S VBUF(60.04)=SUBID ; Subscriber ID 119 . S VBUF(62.01)=PATID ; Patient/Member ID 120 . S VBUF(20.04)=PPHONE ; Precertification Phone 121 . S VBUF(20.03)=BPHONE ; Billing Phone 122 . S VBUF(60.02)=EFFDT ; Effective Date 123 . S VBUF(60.03)=EXPDT ; Expiration Date 124 . S VBUF(60.05)=WHO ; Whose Insurance 125 . S VBUF(60.06)=REL ; Patient Relationship 126 . S VBUF(60.08)=IDOB ; Insured's DOB 127 . S VBUF(60.09)=ISSN ; Insured's SSN 128 . S VBUF(60.12)=COB ; Coordination of Benefits 129 . S VBUF(60.13)=ISEX ; Insured's Sex 130 . ; 131 . ; If the employer sponsored insurance array exists, then merge it in 132 . I $D(ESGHPARR) M VBUF=ESGHPARR 133 ; 134 ; Do not overwrite the existing insurance co. name if it already exists 135 I $G(ADD)="",$G(BUFF)'="" K VBUF(20.01) 136 ; 137 ; ** initialize IBERROR 138 S IBERROR="" 139 ; 140 ; If need to add a new Buffer entry ... 141 ; 142 ; Variable IBFDA is returned to the calling routine as the IEN of 143 ; the buffer entry that was just added. 144 ; 145 I $G(ADD) D 146 . S IBFDA=$$ADDSTF^IBCNBES(5,DFN,.VBUF) 147 . ; Error Message is 2nd piece of result 148 . S IBERROR=$P(IBFDA,U,2) 149 . S IBFDA=$P(IBFDA,U,1) 150 ; 151 ; If an error, send an email message 152 I IBERROR'="" D Q 153 . S MSG(1)="Error returned by $$ADDSTF^IBCNBES:" 154 . S MSG(2)=IBERROR 155 . S MSG(3)="Values:" 156 . S MSG(4)=" Patient DFN = "_$G(DFN) 157 . S MSG(5)=" Pt Ins Record IEN = "_$G(IRIEN) 158 . S MSG(6)="Please log a Remedy Ticket for this problem." 159 . S XMSUB="Error creating Buffer Entry." 160 . D MSG^IBCNEUT5(MSGP,XMSUB,"MSG(") 161 . K MSGP,MSG,XMSUB,IBERR 162 ; 163 ; If need to update a new Buffer Entry ... 164 ; 165 ; Variable BUFF is passed into this routine whenever the buffer 166 ; entry is known and the ADD flag is off. The existing buffer entry 167 ; is edited in this case. 168 ; 169 I $G(ADD)="" D EDITSTF^IBCNBES(BUFF,.VBUF) 170 ; 171 ; If an error occurred in EDITSTF, the error array is not returned 172 ; 173 Q 1 IBCNEBF ;DAOU/ALA - Create an Entry in the Buffer File ;20-JUN-2002 2 ;;2.0;INTEGRATED BILLING;**184,271,361**;21-MAR-94;Build 9 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;**Program Description** 6 ; This program will create a Buffer entry based upon input values 7 ; 8 Q 9 ; 10 PT(DFN,IRIEN,SYMBOL,OVRRIDE,ADD,IBERROR) ; Get data 11 ; from a specific patient and insurance record entry 12 ; 13 ; Input Parameters 14 ; DFN = Patient IEN 15 ; IRIEN = Patient Insurance Record IEN 16 ; SYMBOL = IIV Symbol IEN 17 ; OVRRIDE = Override flag for ins. buffer record (0 or 1) 18 ; ADD = If defined, then it will add a new Buffer entry 19 ; IBERROR = If defined, then it will be updated with error info. 20 ; OPTIONALLY PASSED BY REFERENCE 21 ; 22 I DFN=""!(IRIEN="") Q ; * do not require SYMBOL or OVRRIDE 23 ; 24 ; 25 NEW VBUF,IEN,INAME,PNAME,IIEN,GNUMB,GNAME,SUBID,PPHONE 26 NEW BPHONE,EFFDT,EXPDT,WHO,REL,IDOB,ISSN,COB,TQIEN,RDATA,ISEX,NAME 27 NEW MSG,XMSUB,MSGP,INSDATA,PCE,BFD,BFN,INSPCE,ESGHPARR 28 ; 29 S IIEN=$P($G(^DPT(DFN,.312,IRIEN,0)),U,1) 30 S INAME=$$GET1^DIQ(36,IIEN,.01,"E") 31 S PPHONE=$P($G(^DIC(36,IIEN,.13)),U,3) 32 S BPHONE=$P($G(^DIC(36,IIEN,.13)),U,2) 33 S NAME=$P($G(^DPT(DFN,.312,IRIEN,0)),U,17) 34 S SUBID=$P($G(^DPT(DFN,.312,IRIEN,0)),U,2) 35 S WHO=$P($G(^DPT(DFN,.312,IRIEN,0)),U,6) 36 S COB=$P($G(^DPT(DFN,.312,IRIEN,0)),U,20) 37 S IDOB=$P($G(^DPT(DFN,.312,IRIEN,3)),U,1) 38 S ISSN=$P($G(^DPT(DFN,.312,IRIEN,3)),U,5) 39 S ISEX=$P($G(^DPT(DFN,.312,IRIEN,3)),U,12) 40 S EFFDT=$P(^DPT(DFN,.312,IRIEN,0),U,8) 41 S EXPDT=$P(^DPT(DFN,.312,IRIEN,0),U,4) 42 S REL=$P(^DPT(DFN,.312,IRIEN,0),U,16) 43 ; 44 S IENS=IRIEN_","_DFN_"," 45 S GNUMB=$$GET1^DIQ(2.312,IENS,21,"E") 46 S GNAME=$$GET1^DIQ(2.312,IENS,20,"E") 47 ; 48 ; Capture the employer sponsored insurance fields into array 49 ; ESGHPARR(buffer field number) = data 50 ; 51 S INSDATA=$G(^DPT(DFN,.312,IRIEN,2)),PCE=0 52 F BFD=5:1:12,2,1,3,4 S PCE=PCE+1,BFN=BFD/100+61,INSPCE=$P(INSDATA,U,PCE) I INSPCE'="" S ESGHPARR(BFN)=INSPCE 53 ; 54 D FIL 55 K ADD 56 Q 57 ; 58 RP(IEN,ADD,BUFF) ; Get data from a specific response record 59 ; 60 ; Input Parameter 61 ; IEN = Internal entry number of the Response 62 ; ADD = If defined, then it will add a new Buffer entry 63 ; BUFF = IEN of the Buffer Entry to be updated (optional) 64 ; 65 S BUFF=$G(BUFF) ; Initialize optional parameter 66 ; 67 NEW PIEN,RSTYPE 68 S DFN=$P(^IBCN(365,IEN,0),U,2),TQIEN=$P(^IBCN(365,IEN,0),U,5) 69 S PIEN=$P(^IBCN(365,IEN,0),U,3),RSTYPE=$P(^(0),U,10) 70 I PIEN'="" S PNAME=$P(^IBE(365.12,PIEN,0),U,1) 71 I TQIEN'="" S IRIEN=$P($G(^IBCN(365.1,TQIEN,0)),U,13) 72 I $G(IRIEN)'="" S INAME="" D 73 . S IIEN=$P($G(^DPT(DFN,.312,IRIEN,0)),U,1) 74 . I IIEN="" Q 75 . S INAME=$P(^DIC(36,IIEN,0),U,1) 76 S RDATA=$G(^IBCN(365,IEN,1)) 77 S NAME=$P(RDATA,U,1) 78 S INAME=$S($G(INAME)'=""&(RSTYPE="O"):INAME,1:$G(PNAME)) 79 S IDOB=$P(RDATA,U,2) 80 S ISSN=$P(RDATA,U,3) 81 S ISEX=$P(RDATA,U,4) 82 S COB=$P(RDATA,U,13) 83 S SUBID=$P(RDATA,U,5) 84 S GNAME=$P(RDATA,U,6) 85 S GNUMB=$P(RDATA,U,7) 86 S WHO=$P(RDATA,U,8) 87 S REL=$P(RDATA,U,9) 88 S EFFDT=$P(RDATA,U,11) 89 S EXPDT=$P(RDATA,U,12) 90 S PPHONE="",BPHONE="" 91 ; 92 D FIL 93 K DFN,VBUF,IEN,IRIEN,INAME,PNAME,IIEN,GNUMB,GNAME,SUBID,PPHONE 94 K BPHONE,EFFDT,EXPDT,WHO,REL,IDOB,ISSN,COB,TQIEN,RDATA,ISEX,NAME 95 K ADD,%DT,D0,DG,DIC,DISYS,DIW,IENS 96 Q 97 ; 98 FIL ; File Buffer Data 99 ; 100 S MSGP=$$MGRP^IBCNEUT5() 101 ; 102 ; Variable IDUZ is optionally set by the calling routine. If it is 103 ; not defined, it will be set to the specific, non-human user. 104 ; 105 I $G(IDUZ)="" S IDUZ=$$FIND1^DIC(200,"","X","INTERFACE,IB IIV") 106 ; 107 I $G(ADD) S VBUF(.02)=IDUZ ; Entered By 108 S VBUF(.12)=$G(SYMBOL) ; Buffer Symbol 109 S VBUF(.13)=$G(OVRRIDE) ; Override freshness flag 110 I '$G(ERACT) D ; Only file if not an error 111 . S VBUF(20.01)=INAME ; Insurance Company/Payer Name 112 . S VBUF(60.01)=DFN ; Patient IEN 113 . S VBUF(40.03)=GNUMB ; Group Number 114 . S VBUF(40.02)=GNAME ; Group Name 115 . S VBUF(60.07)=NAME ; Name of Insured 116 . S VBUF(60.04)=SUBID ; Subscriber ID 117 . S VBUF(20.04)=PPHONE ; Precertification Phone 118 . S VBUF(20.03)=BPHONE ; Billing Phone 119 . S VBUF(60.02)=EFFDT ; Effective Date 120 . S VBUF(60.03)=EXPDT ; Expiration Date 121 . S VBUF(60.05)=WHO ; Whose Insurance 122 . S VBUF(60.06)=REL ; Patient Relationship 123 . S VBUF(60.08)=IDOB ; Insured's DOB 124 . S VBUF(60.09)=ISSN ; Insured's SSN 125 . S VBUF(60.12)=COB ; Coordination of Benefits 126 . S VBUF(60.13)=ISEX ; Insured's Sex 127 . ; 128 . ; If the employer sponsored insurance array exists, then merge it in 129 . I $D(ESGHPARR) M VBUF=ESGHPARR 130 ; 131 ; Do not overwrite the existing insurance co. name if it already exists 132 I $G(ADD)="",$G(BUFF)'="" K VBUF(20.01) 133 ; 134 ; ** initialize IBERROR 135 S IBERROR="" 136 ; 137 ; If need to add a new Buffer entry ... 138 ; 139 ; Variable IBFDA is returned to the calling routine as the IEN of 140 ; the buffer entry that was just added. 141 ; 142 I $G(ADD) D 143 . S IBFDA=$$ADDSTF^IBCNBES(5,DFN,.VBUF) 144 . ; Error Message is 2nd piece of result 145 . S IBERROR=$P(IBFDA,U,2) 146 . S IBFDA=$P(IBFDA,U,1) 147 ; 148 ; If an error, send an email message 149 I IBERROR'="" D Q 150 . S MSG(1)="Error returned by $$ADDSTF^IBCNBES:" 151 . S MSG(2)=IBERROR 152 . S MSG(3)="Values:" 153 . S MSG(4)=" Patient DFN = "_$G(DFN) 154 . S MSG(5)=" Pt Ins Record IEN = "_$G(IRIEN) 155 . S MSG(6)="Please log a NOIS for this problem." 156 . S XMSUB="Error creating Buffer Entry." 157 . D MSG^IBCNEUT5(MSGP,XMSUB,"MSG(") 158 . K MSGP,MSG,XMSUB,IBERR 159 ; 160 ; If need to update a new Buffer Entry ... 161 ; 162 ; Variable BUFF is passed into this routine whenever the buffer 163 ; entry is known and the ADD flag is off. The existing buffer entry 164 ; is edited in this case. 165 ; 166 I $G(ADD)="" D EDITSTF^IBCNBES(BUFF,.VBUF) 167 ; 168 ; If an error occurred in EDITSTF, the error array is not returned 169 ; 170 Q
Note:
See TracChangeset
for help on using the changeset viewer.
