| [623] | 1 | MHV7B1B ;WAS/GPM - HL7 message builder RTB^K13 Rx Profile ; [8/22/05 11:45pm]
|
|---|
| 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 | RDF(HL) ; Build RDF segment for Rx Profile data
|
|---|
| 8 | N RDF
|
|---|
| 9 | S RDF(0)="RDF"
|
|---|
| 10 | S RDF(1)=20
|
|---|
| 11 | S RDF(2,1,1)="Prescription Number",RDF(2,1,2)="ST",RDF(2,1,3)=20
|
|---|
| 12 | S RDF(2,2,1)="IEN",RDF(2,2,2)="NM",RDF(2,2,3)=30
|
|---|
| 13 | S RDF(2,3,1)="Drug Name",RDF(2,3,2)="ST",RDF(2,3,3)=40
|
|---|
| 14 | S RDF(2,4,1)="Issue Date/Time",RDF(2,4,2)="TS",RDF(2,4,3)=26
|
|---|
| 15 | S RDF(2,5,1)="Last Fill Date",RDF(2,5,2)="TS",RDF(2,5,3)=26
|
|---|
| 16 | S RDF(2,6,1)="Release Date/Time",RDF(2,6,2)="TS",RDF(2,6,3)=26
|
|---|
| 17 | S RDF(2,7,1)="Expiration or Cancel Date",RDF(2,7,2)="TS",RDF(2,7,3)=26
|
|---|
| 18 | S RDF(2,8,1)="Status",RDF(2,8,2)="ST",RDF(2,8,3)=25
|
|---|
| 19 | S RDF(2,9,1)="Quantity",RDF(2,9,2)="NM",RDF(2,9,3)=11
|
|---|
| 20 | S RDF(2,10,1)="Days Supply",RDF(2,10,2)="NM",RDF(2,10,3)=3
|
|---|
| 21 | S RDF(2,11,1)="Number of Refills",RDF(2,11,2)="NM",RDF(2,11,3)=3
|
|---|
| 22 | S RDF(2,12,1)="Provider",RDF(2,12,2)="XCN",RDF(2,12,3)=150
|
|---|
| 23 | S RDF(2,13,1)="Placer Order Number",RDF(2,13,2)="ST",RDF(2,13,3)=30
|
|---|
| 24 | S RDF(2,14,1)="Mail/Window",RDF(2,14,2)="ST",RDF(2,14,3)=1
|
|---|
| 25 | S RDF(2,15,1)="Division",RDF(2,15,2)="NM",RDF(2,15,3)=3
|
|---|
| 26 | S RDF(2,16,1)="Division Name",RDF(2,16,2)="ST",RDF(2,16,3)=20
|
|---|
| 27 | S RDF(2,17,1)="MHV Request Status",RDF(2,17,2)="NM",RDF(2,17,3)=3
|
|---|
| 28 | S RDF(2,18,1)="MHV Request Status Date",RDF(2,18,2)="TS",RDF(2,18,3)=26
|
|---|
| 29 | S RDF(2,19,1)="Remarks",RDF(2,19,2)="ST",RDF(2,19,3)=75
|
|---|
| 30 | S RDF(2,20,1)="SIG",RDF(2,20,2)="TX",RDF(2,20,3)=1024
|
|---|
| 31 | Q $$BLDSEG^MHV7U(.RDF,.HL)
|
|---|
| 32 | ;
|
|---|
| 33 | RDT(MSGROOT,DATAROOT,CNT,HL) ; Build RDT segments for Rx Profile data
|
|---|
| 34 | ;
|
|---|
| 35 | ; Walks data in DATAROOT to popoulate MSGROOT with RDT segments
|
|---|
| 36 | ; sequentially numbered starting at CNT
|
|---|
| 37 | ;
|
|---|
| 38 | ; Integration Agreements:
|
|---|
| 39 | ; 3065 : $$HLNAME^XLFNAME
|
|---|
| 40 | ;
|
|---|
| 41 | ; Input:
|
|---|
| 42 | ; MSGROOT - Root of array holding the message
|
|---|
| 43 | ; DATAROOT - Root of array to hold extract data
|
|---|
| 44 | ; CNT - Current message line counter
|
|---|
| 45 | ; HL - HL7 package array variable
|
|---|
| 46 | ;
|
|---|
| 47 | ; Output:
|
|---|
| 48 | ; - Populated message array
|
|---|
| 49 | ;
|
|---|
| 50 | N I,RX,RX0,RXP,RXN,RXD,RDT,SIG,SEG,PIEN,NAME
|
|---|
| 51 | F I=1:1 Q:'$D(@DATAROOT@(I)) D
|
|---|
| 52 | . S RX=@DATAROOT@(I)
|
|---|
| 53 | . S RX0=@DATAROOT@(I,0)
|
|---|
| 54 | . S RXP=@DATAROOT@(I,"P")
|
|---|
| 55 | . S PIEN=+RXP
|
|---|
| 56 | . S RXN=@DATAROOT@(I,"RXN")
|
|---|
| 57 | . S RXD=@DATAROOT@(I,"DIV")
|
|---|
| 58 | . K SIG M SIG=@DATAROOT@(I,"SIG")
|
|---|
| 59 | . S RDT(0)="RDT"
|
|---|
| 60 | . S RDT(1)=$P(RX,"^") ;Rx Number
|
|---|
| 61 | . S RDT(2)=$P(RXN,"^",9) ;Rx IEN
|
|---|
| 62 | . S RDT(3)=$$ESCAPE^MHV7U($P(RX,"^",2),.HL) ;Drug Name
|
|---|
| 63 | . S RDT(4)=$$FMTHL7^XLFDT($P(RX0,"^",5)) ;Issue Date/Time
|
|---|
| 64 | . S RDT(5)=$$FMTHL7^XLFDT($P(RX0,"^",12)) ;Last Fill Date
|
|---|
| 65 | . S RDT(6)=$$FMTHL7^XLFDT($P(RXN,"^",2)) ;Release Date/Time
|
|---|
| 66 | . S RDT(7)=$$FMTHL7^XLFDT($P(RX0,"^",3)) ;Expiration/Cancel Date
|
|---|
| 67 | . S RDT(8)=$$ESCAPE^MHV7U($P(RX0,"^",6),.HL) ;Status
|
|---|
| 68 | . S RDT(9)=$P(RX0,"^",8) ;Quantity
|
|---|
| 69 | . S RDT(10)=$P(RX0,"^",7) ;Days Supply
|
|---|
| 70 | . S RDT(11)=$P(RX0,"^",4) ;Number of Refills
|
|---|
| 71 | . I PIEN D
|
|---|
| 72 | .. S RDT(12,1,1)=PIEN ;Provider IEN
|
|---|
| 73 | .. S NAME("FILE")=200,NAME("FIELD")=.01,NAME("IENS")=PIEN_","
|
|---|
| 74 | .. S NAME=$$HLNAME^XLFNAME(.NAME,"","^")
|
|---|
| 75 | .. S RDT(12,1,2)=$$ESCAPE^MHV7U($P(NAME,"^"),.HL) ;family
|
|---|
| 76 | .. S RDT(12,1,3)=$$ESCAPE^MHV7U($P(NAME,"^",2),.HL) ;given
|
|---|
| 77 | .. S RDT(12,1,4)=$$ESCAPE^MHV7U($P(NAME,"^",3),.HL) ;middle
|
|---|
| 78 | .. S RDT(12,1,5)=$$ESCAPE^MHV7U($P(NAME,"^",4),.HL) ;suffix
|
|---|
| 79 | .. S RDT(12,1,6)=$$ESCAPE^MHV7U($P(NAME,"^",5),.HL) ;prefix
|
|---|
| 80 | .. S RDT(12,1,7)=$$ESCAPE^MHV7U($P(NAME,"^",6),.HL) ;degree
|
|---|
| 81 | .. Q
|
|---|
| 82 | . S RDT(13)=$$ESCAPE^MHV7U($P(RX0,"^",11),.HL) ;Placer Order Number
|
|---|
| 83 | . S RDT(14)=$P(RXN,"^",3) ;Mail/Window
|
|---|
| 84 | . S RDT(15)=$P(RXD,"^") ;Division
|
|---|
| 85 | . S RDT(16)=$$ESCAPE^MHV7U($P(RXD,"^",2),.HL) ;Division Name
|
|---|
| 86 | . S RDT(17)=$P(RX,"^",3) ;MHV status
|
|---|
| 87 | . S RDT(18)=$$FMTHL7^XLFDT($P(RX,"^",4)) ;MHV status date
|
|---|
| 88 | . S RDT(19)=$$ESCAPE^MHV7U($P(RXN,"^",4),.HL) ;Remarks
|
|---|
| 89 | . S CNT=CNT+1
|
|---|
| 90 | . S @MSGROOT@(CNT)=$$BLDSEG^MHV7U(.RDT,.HL)
|
|---|
| 91 | . Q:'SIG(0)
|
|---|
| 92 | . K SEG
|
|---|
| 93 | . D BLDWPSEG^MHV7U(.SIG,.SEG,1024,.HL)
|
|---|
| 94 | . M @MSGROOT@(CNT)=SEG
|
|---|
| 95 | . Q
|
|---|
| 96 | Q
|
|---|
| 97 | ;
|
|---|
