source: FOIAVistA/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSJACK.m@ 1470

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

initial load of FOIAVistA 6/30/08 version

File size: 5.7 KB
Line 
1BPSJACK ;BHAM ISC/LJF - HL7 Acknowledgement Messages ;21-NOV-2003
2 ;;1.0;E CLAIMS MGMT ENGINE;**1,2,5**;JUN 2004;Build 45
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ; This routine examines an Acknowledgement Message. If the message is
6 ; the E-PHARM Application Acknowledgement Message, and it is "AA",
7 ; it kicks off the Pharmacy Registration Messages.
8 ; If the message flags an error, then error notification is processed.
9 ;
10EN(HL) N ACK,AREG,BPSJSEG,ERR,HCT,SEG
11 N MFI,MFIIX,MSGCTLID,MSGID,MSGIX,MSH
12 ;
13 I '$D(HL) Q
14 ;
15 S (AREG,HCT,MFIIX,MSGCTLID,MSGID,MSGIX)=0,(ACK,MFI,MSH)=""
16 S ERR("MSA")=""
17 ; Loop through the message and find each segment for processing
18 F S HCT=$O(^TMP($J,"BPSJHLI",HCT)) Q:HCT="" D
19 . K BPSJSEG D SPAR^BPSJUTL(.HL,.BPSJSEG,HCT) S SEG=$G(BPSJSEG(1))
20 . ;
21 . I SEG="MSH" D Q
22 . . S MSGCTLID=$G(BPSJSEG(10)) ; get the message control id
23 . ;
24 . I SEG="MSA" D Q ; MSA seg looks like this -> MSA|AA|509133482
25 . . S ACK=$G(BPSJSEG(2)),MSGID=$G(BPSJSEG(3)) K ERR("MSA")
26 . ;
27 . I SEG="MFI",ACK="AA",$P($G(BPSJSEG(2)),$E($G(HL("ECH"))))="Facility Table" S AREG=1
28 . ;
29 . ;GET NPI
30 . I SEG="MFI",ACK="AA",$P($G(BPSJSEG(2)),$E($G(HL("ECH"))))="Pharmacy Table" D
31 . . I '$G(MSGID) Q
32 . . N BPSJNPI,BPSJPIX,BPSJNDT,BPSJ,HLMAID,HLID
33 . . S HLMAID=$O(^HLMA("C",MSGID,"")) I '$G(HLMAID) Q
34 . . S HLID=$P(^HLMA(HLMAID,0),U) I '$G(HLID) Q
35 . . S BPSJNPI=$P($G(^HL(772,HLID,"IN",22,0)),"|") I '$G(BPSJNPI) Q
36 . . S BPSJ=$G(^XTMP("BPSJ","NPI",BPSJNPI)) I 'BPSJ Q
37 . . S BPSJPIX=$P(BPSJ,U),BPSJNDT=$P(BPSJ,U,2)
38 . . N DA,DIC,DIE,DINUM,DIR,DIRUT,DIROUT,DLAYGO,DR,DTOUT,DUOUT,X,Y
39 . . S DA=BPSJPIX,DIE=$$ROOT^DILFD(9002313.56)
40 . . S DR="41.01////"_BPSJNPI_";41.02////"_BPSJNDT D ^DIE
41 . . K ^XTMP("BPSJ","NPI",BPSJNPI)
42 . ;
43 . I SEG="MFA",ACK="AE" S ERR("MFA",U_$G(BPSJSEG(5)))="" Q
44 ;
45 ; Pharmacy Registrations
46 I AREG S AREG=0 D
47 . F S AREG=$O(^BPS(9002313.56,AREG)) Q:'AREG D REG^BPSJPREG(AREG)
48 ;
49 I $D(ERR) D ERRORM D MSG^BPSJUTL(.ERR,"BPSJACK")
50 Q
51 ;
52ERRORM ; Error message setup
53 N ERRT
54 ;
55 S ERR(1)="Error(s) indicated for HL7 Application Acknowledge Message ID: "_$G(MSGCTLID)
56 I $D(ERR("MSA")) S ERR(2)="Error:NO MSA - No MSA segment found."
57 I $D(ERR("MFA")) S ERRT="" F S ERRT=$O(ERR("MFA",ERRT)) Q:ERRT="" D
58 . I ERRT["NC100" S ERR(100)="Error:NC100 - Invalid OP Interface version." Q
59 . I ERRT["NC200" S ERR(200)="Error:NC200 - Not e-IIV registered." Q
60 . I ERRT["NC201" S ERR(201)="Error:NC201 - Invalid IIV Interface version." Q
61 . I ERRT["NC202" S ERR(202)="Error:NC202 - Invalid e-IIV registration state." Q
62 . I ERRT["NC300" S ERR(300)="Error:NC300 - OP pharmacy not registered. Failed to update Pharmacy information." Q
63 . I ERRT["NC301" S ERR(301)="Error:NC301 - Unable to update Pharmacy information due to outpatient pharmacy registration has invalid OP interface version." Q
64 . I ERRT["NC302" S ERR(302)="Error:NC302 - Unable to update Pharmacy information due to invalid e-IIV registration state." Q
65 . S ERR(399)="Error:"_ERRT_" - Unknown error."
66 K ERR("MFA"),ERR("MSA")
67 ;
68 Q
69 ;
70APPACK(HL,APPACK,PSIEN) ; Application Acknowledgement for Payer Sheets
71 N MGRP,MSG,MCT,BPSGENR
72 N TLN,FS,FS2,FS3,CS
73 ;
74 K ^TMP("HLA",$J)
75 ;
76 ;-Set up HL7
77 D INIT^HLFNC2("BPSJ REGISTER",.HL)
78 ;
79 D DGAPPACK ; Dollar G the APPACK variable (bullet proofing)
80 ;
81 S FS=$G(HL("FS")) I FS="" S FS="|" ; field separator
82 S CS=$E($G(HL("ECH"))) I CS="" S CS="^" ; component separator
83 ;
84 S MCT=0,FS2=FS_FS,FS3=FS_FS_FS
85 ;
86 ;-MSA SEG
87 I APPACK("MFA",4,1)="S" S ^TMP("HLA",$J,1)="MSA"_FS_"AA"_FS_APPACK("MSA",2)
88 E S ^TMP("HLA",$J,1)="MSA"_FS_"AE"_FS_APPACK("MSA",2)
89 ;
90 ;-MFI SEG
91 S TLN="MFI"_FS_APPACK("MFI",1,1)_CS_APPACK("MFI",1,2)_FS2
92 S ^TMP("HLA",$J,2)=TLN_APPACK("MFI",3)_FS3_APPACK("MFI",6)
93 ;
94 ;-MFA SEG(S)
95 I APPACK("MFA",4,1)="S" D S ^TMP("HLA",$J,3)=TLN
96 . S TLN="MFA"_FS_APPACK("MFA",1)_FS_APPACK("MFA",2)_FS2
97 . S TLN=TLN_APPACK("MFA",4,1)_CS_APPACK("MFA",4,2)_FS
98 . S TLN=TLN_APPACK("MFA",5)_FS_APPACK("MFA",6)
99 E D MFASEGS
100 ;
101 D GENACK^HLMA1($G(HL("EID")),$G(HL("HLMTIENS")),$G(HL("EIDS")),"GM",1,.BPSGENR)
102 ;
103 K ^TMP("HLA",$J)
104 Q
105 ;
106MFASEGS ; Set up the MFA segs for Reject message
107 N MFAP1,MFAP2,MFACNTR,FIELD,RECORD,ZPRERR
108 ;
109 S MFAP1="MFA"_FS_APPACK("MFA",1)_FS_APPACK("MFA",2)
110 S MFAP1=MFAP1_FS2_APPACK("MFA",4,1)_CS
111 S MFAP2=FS_APPACK("MFA",5)_FS_APPACK("MFA",6)
112 S MFACNTR=2
113 ;
114 I $D(^TMP($J,"BPSJ-ERROR","MFI")) S FIELD="" D
115 . F S FIELD=$O(^TMP($J,"BPSJ-ERROR","MFI",FIELD)) Q:'FIELD D
116 .. S MFACNTR=MFACNTR+1
117 .. S ^TMP("HLA",$J,MFACNTR)=MFAP1_"V60"_FIELD_MFAP2
118 ;
119 I $D(^TMP($J,"BPSJ-ERROR","MFE")) S FIELD="" D
120 . F S FIELD=$O(^TMP($J,"BPSJ-ERROR","MFE",FIELD)) Q:'FIELD D
121 .. S MFACNTR=MFACNTR+1
122 .. S ^TMP("HLA",$J,MFACNTR)=MFAP1_"V61"_FIELD_MFAP2
123 ;
124 I $D(^TMP($J,"BPSJ-ERROR","ZPS")) S FIELD="" D
125 . F S FIELD=$O(^TMP($J,"BPSJ-ERROR","ZPS",FIELD)) Q:'FIELD D
126 .. S MFACNTR=MFACNTR+1
127 .. S ^TMP("HLA",$J,MFACNTR)=MFAP1_"V62"_FIELD_MFAP2
128 ;
129 I $D(^TMP($J,"BPSJ-ERROR","ZPR")) S RECORD="" D
130 . F S RECORD=$O(^TMP($J,"BPSJ-ERROR","ZPR",RECORD)),FIELD="" Q:'RECORD D
131 .. F S FIELD=$O(^TMP($J,"BPSJ-ERROR","ZPR",RECORD,FIELD)) Q:'FIELD D
132 ... S ZPRERR=$G(^TMP($J,"BPSJ-ERROR","ZPR",RECORD,FIELD))
133 ... S MFACNTR=MFACNTR+1,^TMP("HLA",$J,MFACNTR)=MFAP1_ZPRERR_MFAP2
134 ;
135 Q
136DGAPPACK ; $G the APPACK var
137 S APPACK("MFA",1)=$G(APPACK("MFA",1))
138 S APPACK("MFA",2)=$G(APPACK("MFA",2))
139 S APPACK("MFA",3)=$G(APPACK("MFA",3))
140 S APPACK("MFA",4,1)=$G(APPACK("MFA",4,1))
141 S APPACK("MFA",4,2)=$G(APPACK("MFA",4,2))
142 S APPACK("MFA",5)=$G(APPACK("MFA",5))
143 S APPACK("MFA",6)=$G(APPACK("MFA",6))
144 S APPACK("MFI",1,1)=$G(APPACK("MFI",1,1))
145 S APPACK("MFI",1,2)=$G(APPACK("MFI",1,2))
146 S APPACK("MFI",3)=$G(APPACK("MFI",3))
147 S APPACK("MFI",6)=$G(APPACK("MFI",6))
148 S APPACK("MSA",1)=$G(APPACK("MSA",1))
149 S APPACK("MSA",2)=$G(APPACK("MSA",2))
150 Q
Note: See TracBrowser for help on using the repository browser.