Changeset 623 for WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B1.m
r613 r623 1 MHV7B1 ;WAS/GPM - HL7 message builder RTB^K13 ; [1/7/08 10:45pm] 2 ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 RTBK13(MSGROOT,QRY,ERR,DATAROOT,LEN,HL) ; Build query response 8 ; 9 ; Populates the array pointed to by MSGROOT with an RTB^K13 query 10 ; response message by calling the appropriate segment builders based 11 ; on the type of response ACK/Data or NAK. Extracted data pointed to 12 ; by DATAROOT, errors, hit counts, and query information are used to 13 ; build the segments. 14 ; An error number in ERR^4 indicates a NAK is needed. 15 ; DATAROOT being null indicates a dataless ACK (testing purposes). 16 ; Multiple types of RDF/RDT are supported based on the type of 17 ; data in the response. The appropriate domain specific builder is 18 ; called based on QRY("BUILDER"). Note that this is a different 19 ; routine than the XMT("BUILDER"). 20 ; 21 ; Input: 22 ; MSGROOT - Global root of message 23 ; QRY - Query parameters 24 ; QRY("BUILDER") - Domain specific builder routine 25 ; QRY("MID") - original message control ID 26 ; ERR - Caret delimited error string 27 ; segment^sequence^field^code^ACK type^error text 28 ; DATAROOT - Global root of data array 29 ; HL - HL7 package array variable 30 ; 31 ; Output: RTB^K13 message in MSGROOT 32 ; LEN - Length of formatted message 33 ; 34 N CNT,RDT,HIT,EXTIME 35 D LOG^MHVUL2("RTB-K13 BUILDER","BEGIN","S","TRACE") 36 ; 37 S HIT=0,EXTIME="" 38 I DATAROOT'="" D 39 . S HIT=+$P($G(@DATAROOT),"^",1) 40 . S EXTIME=$P($G(@DATAROOT),"^",2) 41 . Q 42 S HIT=HIT_"^"_HIT_"^0" 43 ; 44 K @MSGROOT 45 S CNT=1,@MSGROOT@(CNT)=$$MSA^MHV7BUS($G(QRY("MID")),ERR,.HL),LEN=$L(@MSGROOT@(CNT)) 46 I $P(ERR,"^",4) S CNT=CNT+1,HIT="0^0^0",@MSGROOT@(CNT)=$$ERR^MHV7BUS(ERR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) 47 S CNT=CNT+1,@MSGROOT@(CNT)=$$QAK^MHV7BUS(.QRY,ERR,HIT,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) 48 S CNT=CNT+1,@MSGROOT@(CNT)=$$QPD^MHV7BUS(.QRY,EXTIME,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) 49 I '$P(ERR,"^",4) D 50 . D @("RDF^"_QRY("BUILDER")_"(MSGROOT,.CNT,.LEN,.HL)") 51 . Q:DATAROOT="" 52 . Q:HIT<1 53 . D @("RDT^"_QRY("BUILDER")_"(MSGROOT,DATAROOT,.CNT,.LEN,.HL)") 54 . Q 55 ; 56 D LOG^MHVUL2("RTB-K13 BUILDER","END","S","TRACE") 57 Q 58 ; 1 MHV7B1 ;WAS/GPM - HL7 message builder RTB^K13 ; [8/22/05 6:18pm] 2 ;;1.0;My HealtheVet;;Aug 23, 2005 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 RTBK13(MSGROOT,QRY,ERR,DATAROOT,HL) ; Build query response 8 ; 9 ; Populates the array pointed to by MSGROOT with an RTB^K13 query 10 ; response message by calling the appropriate segment builders based 11 ; on the type of response ACK/Data or NAK. Extracted data pointed to 12 ; by DATAROOT, errors, hit counts, and query information are user to 13 ; buld the segments. 14 ; An error number in ERR^4 indicates a NAK is needed. 15 ; DATAROOT being null indicates a dataless ACK (testing purposes). 16 ; Multiple types of RDF/RDT are supported based on the type of 17 ; data in the response, indicated by QRY("TYPE"). 18 ; 19 ; Input: 20 ; MSGROOT - Global root of message 21 ; QRY - Query parameters 22 ; QRY("TYPE") - Request type number 23 ; QRY("MID") - original message control ID 24 ; ERR - Caret delimited error string 25 ; segment^sequence^field^code^ACK type^error text 26 ; DATAROOT - Global root of data array 27 ; HL - HL7 package array variable 28 ; 29 ; Output: RTB^K13 message in MSGROOT 30 ; 31 N CNT,RDT,HIT 32 S HIT="" 33 I DATAROOT'="" S HIT=$G(@DATAROOT) 34 I HIT="" S HIT=0 35 S HIT=HIT_"^"_HIT_"^0" 36 K @MSGROOT 37 S CNT=1,@MSGROOT@(CNT)=$$MSA($G(QRY("MID")),ERR,.HL) 38 I $P(ERR,"^",4) S CNT=CNT+1,HIT="0^0^0",@MSGROOT@(CNT)=$$ERR(ERR,.HL) 39 S CNT=CNT+1,@MSGROOT@(CNT)=$$QAK(.QRY,ERR,HIT,.HL) 40 S CNT=CNT+1,@MSGROOT@(CNT)=$$QPD(.QRY,.HL) 41 Q:$P(ERR,"^",4) 42 S CNT=CNT+1,@MSGROOT@(CNT)=$$RDF(QRY("TYPE"),.HL) 43 Q:DATAROOT="" 44 Q:@DATAROOT<1 45 D RDT(MSGROOT,QRY("TYPE"),DATAROOT,.CNT,.HL) 46 Q 47 ; 48 MSA(MID,ERROR,HL) ;build MSA segment 49 N MSA,ACK 50 S ACK=$P(ERROR,"^",5) 51 I ACK="" S ACK="AA" 52 S MSA(0)="MSA" 53 S MSA(1)=ACK ;ACK code 54 S MSA(2)=MID ;message control ID 55 S MSA(3)=$$ESCAPE^MHV7U($P(ERROR,"^",6),.HL) ;text message 56 Q $$BLDSEG^MHV7U(.MSA,.HL) 57 ; 58 ERR(ERROR,HL) ;build ERR segment 59 N ERR 60 S ERR(0)="ERR" 61 S ERR(1,1,1)=$P(ERROR,"^",1) ;segment 62 S ERR(1,1,2)=$P(ERROR,"^",2) ;sequence 63 S ERR(1,1,3)=$P(ERROR,"^",3) ;field 64 S ERR(1,1,4,1)=$P(ERROR,"^",4) ;code 65 S ERR(1,1,4,2)=$$ESCAPE^MHV7U($P(ERROR,"^",6),.HL) ;text 66 Q $$BLDSEG^MHV7U(.ERR,.HL) 67 ; 68 QAK(QRY,ERROR,HIT,HL) ;build QAK segment 69 N QAK,STATUS 70 S STATUS=$P(ERROR,"^",5) 71 I STATUS="" S STATUS="OK" 72 I STATUS="OK",HIT<1 S STATUS="NF" 73 S QAK(0)="QAK" 74 S QAK(1)=QRY("QPD",2) ;query tag 75 S QAK(2)=STATUS ;query response status 76 M QAK(3)=QRY("QPD",1) ;message query name 77 S QAK(4)=$P(HIT,"^",1) ;hit count total 78 S QAK(5)=$P(HIT,"^",2) ;hits this payload 79 S QAK(6)=$P(HIT,"^",3) ;hits remaining 80 Q $$BLDSEG^MHV7U(.QAK,.HL) 81 ; 82 QPD(QRY,HL) ;build QPD segment 83 N QPD 84 M QPD=QRY("QPD") 85 S QPD(0)="QPD" 86 S QPD(7)=$G(QRY("ICN")) ;ICN 87 S QPD(8)=$G(QRY("DFN")) ;DFN 88 Q $$BLDSEG^MHV7U(.QPD,.HL) 89 ; 90 RDF(REQTYPE,HL) ; build RDF segment 91 N RTN 92 S RTN=$$RTN(REQTYPE) 93 Q:RTN="" "RDF" 94 Q @("$$RDF^"_RTN_"(.HL)") 95 ; 96 RDT(MSGROOT,REQTYPE,DATAROOT,CNT,HL) ; Build RDT segments 97 N RTN 98 S RTN=$$RTN(REQTYPE) 99 Q:RTN="" 100 D @("RDT^"_RTN_"(MSGROOT,DATAROOT,.CNT,.HL)") 101 Q 102 ; 103 RTN(REQTYPE) ; 104 N RDEF 105 S RDEF(3)="MHV7B1B" 106 S RDEF(21)="MHV7B1B" 107 Q $G(RDEF(REQTYPE)) 108 ;
Note:
See TracChangeset
for help on using the changeset viewer.
