Changeset 623 for WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B2.m
r613 r623 1 MHV7B2 ;WAS/GPM - HL7 message builder ORP^O10 ; [12/24/07 5:43pm] 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 ORPO10(MSGROOT,REQ,ERR,DATAROOT,LEN,HL) ; Build refill request response 8 ; 9 ; Populates the array pointed to by MSGROOT with an ORP^O10 order 10 ; response message by calling the appropriate segment builders based 11 ; on the type of response ACK or NAK. Extracted data pointed to 12 ; by DATAROOT, errors, and request parameters are used to build the 13 ; segments. An error number in ERR^4 indicates a NAK is needed. 14 ; 15 ; Integration Agreements: 16 ; 3065 : $$HLNAME^XLFNAME 17 ; 10112 : $$SITE^VASITE 18 ; 19 ; Input: 20 ; MSGROOT - Global root of message 21 ; REQ - Query parameters 22 ; REQ("TYPE") - Request type number 23 ; REQ("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: ORP^O10 message in MSGROOT 30 ; LEN - Length of formatted message 31 ; 32 N CNT,HIT,I 33 D LOG^MHVUL2("ORP-O10 BUILDER","BEGIN","S","TRACE") 34 ; 35 K @MSGROOT 36 S CNT=1,@MSGROOT@(CNT)=$$MSA^MHV7BUS($G(REQ("MID")),ERR,.HL),LEN=$L(@MSGROOT@(CNT)) 37 I $P(ERR,"^",4) S CNT=CNT+1,@MSGROOT@(CNT)=$$ERR^MHV7BUS(ERR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) 38 S CNT=CNT+1,@MSGROOT@(CNT)=$$PID^MHV7BUS(.REQ,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) 39 ; 40 I '$P(ERR,"^",4),DATAROOT'="" D 41 . F I=1:1 Q:'$D(@DATAROOT@(I)) D 42 .. S CNT=CNT+1,@MSGROOT@(CNT)=$$ORC(@DATAROOT@(I),.HL),LEN=LEN+$L(@MSGROOT@(CNT)) 43 .. S CNT=CNT+1,@MSGROOT@(CNT)=$$RXE(@DATAROOT@(I),.HL),LEN=LEN+$L(@MSGROOT@(CNT)) 44 .. Q 45 . Q 46 ; 47 D LOG^MHVUL2("ORP-O10 BUILDER","END","S","TRACE") 48 Q 49 ; 50 ORC(DATA,HL) ;build ORC segment 51 N ORC,STATUS,CONTROL 52 S STATUS=$P(DATA,"^",2) 53 S CONTROL=$S(STATUS=1:"OK",1:"UA") 54 S ORC(0)="ORC" 55 S ORC(1)=CONTROL ;order control 56 S ORC(2)=$P(DATA,"^",3) ;placer order number 57 S ORC(3)=$P(DATA,"^",3) ;filler order number 58 Q $$BLDSEG^MHV7U(.ORC,.HL) 59 ; 60 RXE(DATA,HL) ;build RXE segment 61 N RXE,STATUS,CONTROL 62 S STATUS=$P(DATA,"^",2) 63 S CONTROL=$S(STATUS=1:"OK",1:"UA") 64 S RXE(0)="RXE" 65 S RXE(1,1,1,1)=1 ;order quantity 66 S RXE(1,1,4,1)=$P(DATA,"^",4) ;order start time 67 S RXE(2,1,1)=CONTROL ;give code identifier 68 S RXE(2,1,2)=STATUS ;give code text 69 S RXE(2,1,3)="HL70119" ;give code system 70 S RXE(3)=1 ;give amount 71 S RXE(5)="1 refill unit" ;give units 72 ;S RXE(7)="" ;division number 73 S RXE(15)=$P(DATA,"^",1) ;prescription number 74 Q $$BLDSEG^MHV7U(.RXE,.HL) 75 ; 1 MHV7B2 ;WAS/GPM - HL7 message builder ORP^O10 ; [8/22/05 11:47pm] 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 ORPO10(MSGROOT,REQ,ERR,DATAROOT,HL) ; Build refill request response 8 ; 9 ; Populates the array pointed to by MSGROOT with an ORP^O10 order 10 ; response message by calling the appropriate segment builders based 11 ; on the type of response ACK or NAK. Extracted data pointed to 12 ; by DATAROOT, errors, and request parameters are used to build the 13 ; segments. An error number in ERR^4 indicates a NAK is needed. 14 ; 15 ; Integration Agreements: 16 ; 3065 : $$HLNAME^XLFNAME 17 ; 10112 : $$SITE^VASITE 18 ; 19 ; Input: 20 ; MSGROOT - Global root of message 21 ; REQ - Query parameters 22 ; REQ("TYPE") - Request type number 23 ; REQ("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: ORP^O10 message in MSGROOT 30 ; 31 N CNT,RDT,HIT,I 32 K @MSGROOT 33 S CNT=1,@MSGROOT@(CNT)=$$MSA^MHV7B1($G(REQ("MID")),ERR,.HL) 34 I $P(ERR,"^",4) S CNT=CNT+1,@MSGROOT@(CNT)=$$ERR^MHV7B1(ERR,.HL) 35 Q:$P(ERR,"^",4) 36 S CNT=CNT+1,@MSGROOT@(CNT)=$$PID(.REQ,.HL) 37 F I=1:1 Q:'$D(@DATAROOT@(I)) D 38 . S CNT=CNT+1,@MSGROOT@(CNT)=$$ORC(@DATAROOT@(I),.HL) 39 . S CNT=CNT+1,@MSGROOT@(CNT)=$$RXE(@DATAROOT@(I),.HL) 40 . Q 41 Q 42 ; 43 PID(REQ,HL) ; 44 N PID,NAME,STATION,IDCNT 45 S STATION=$P($$SITE^VASITE,"^",3) 46 S PID(0)="PID" 47 S IDCNT=0 48 I REQ("ICN")'="" D 49 . S IDCNT=IDCNT+1 50 . S PID(3,IDCNT,1)=REQ("ICN") ;Patient ID - ICN 51 . S PID(3,IDCNT,4,1)="USVHA" ;assigning authority ID 52 . S PID(3,IDCNT,4,3)="HL70363" ;assigning authority type 53 . S PID(3,IDCNT,5)="NI" ;Patient ID type 54 . S PID(3,IDCNT,6,1)="VA FACILITY ID" ;assigning facility 55 . S PID(3,IDCNT,6,2)=STATION ;Station number 56 . S PID(3,IDCNT,6,3)="L" ;facility ID type 57 . Q 58 ; 59 I REQ("DFN")'="" D 60 . S IDCNT=IDCNT+1 61 . S PID(3,IDCNT,1)=REQ("DFN") ;Patient ID - DFN 62 . S PID(3,IDCNT,4,1)="USVHA" ;assigning authority ID 63 . S PID(3,IDCNT,4,3)="HL70363" ;assigning authority type 64 . S PID(3,IDCNT,5)="PI" ;Patient ID type 65 . S PID(3,IDCNT,6,1)="VA FACILITY ID" ;assigning facility 66 . S PID(3,IDCNT,6,2)=STATION ;Station number 67 . S PID(3,IDCNT,6,3)="L" ;facility ID type 68 . Q 69 ; 70 I REQ("SSN")'="" D 71 . S IDCNT=IDCNT+1 72 . S PID(3,IDCNT,1)=REQ("SSN") ;Patient ID - SSN 73 . S PID(3,IDCNT,4,1)="USSSA" ;assigning authority ID 74 . S PID(3,IDCNT,4,3)="HL70363" ;assigning authority type 75 . S PID(3,IDCNT,5)="SS" ;Patient ID type 76 . S PID(3,IDCNT,6,1)="VA FACILITY ID" ;assigning facility 77 . S PID(3,IDCNT,6,2)="200MH" ;Station number 78 . S PID(3,IDCNT,6,3)="L" ;facility ID type 79 . Q 80 ; 81 S NAME("FILE")=2,NAME("FIELD")=.01,NAME("IENS")=REQ("DFN")_"," 82 S NAME=$$NAMEFMT^XLFNAME(.NAME) 83 S PID(5,1,1)=$$ESCAPE^MHV7U($P(NAME,"^"),.HL) ;family 84 S PID(5,1,2)=$$ESCAPE^MHV7U($P(NAME,"^",2),.HL) ;given 85 S PID(5,1,3)=$$ESCAPE^MHV7U($P(NAME,"^",3),.HL) ;middle 86 S PID(5,1,4)=$$ESCAPE^MHV7U($P(NAME,"^",4),.HL) ;suffix 87 ; 88 Q $$BLDSEG^MHV7U(.PID,.HL) 89 ; 90 ORC(DATA,HL) ;build ORC segment 91 N ORC,STATUS,CONTROL 92 S STATUS=$P(DATA,"^",2) 93 S CONTROL=$S(STATUS=1:"OK",1:"UA") 94 S ORC(0)="ORC" 95 S ORC(1)=CONTROL ;order control 96 S ORC(2)=$P(DATA,"^",3) ;placer order number 97 S ORC(3)=$P(DATA,"^",3) ;filler order number 98 Q $$BLDSEG^MHV7U(.ORC,.HL) 99 ; 100 RXE(DATA,HL) ;build RXE segment 101 N RXE,STATUS,CONTROL 102 S STATUS=$P(DATA,"^",2) 103 S CONTROL=$S(STATUS=1:"OK",1:"UA") 104 S RXE(0)="RXE" 105 S RXE(1,1,1,1)=1 ;order quantity 106 S RXE(1,1,4,1)=$P(DATA,"^",4) ;order start time 107 S RXE(2,1,1)=CONTROL ;give code identifier 108 S RXE(2,1,2)=STATUS ;give code text 109 S RXE(2,1,3)="HL70119" ;give code system 110 S RXE(3)=1 ;give amount 111 S RXE(5)="1 refill unit" ;give units 112 ;S RXE(7)="" ;division number 113 S RXE(15)=$P(DATA,"^",1) ;prescription number 114 Q $$BLDSEG^MHV7U(.RXE,.HL) 115 ;
Note:
See TracChangeset
for help on using the changeset viewer.
