MHV7B1R2 ;MHV/JBM - HL7 message builder RTB^K13 Medications Profile ; 02/07/22
 ;;1.0;My HealtheVet;**74,91**;Aug 23, 2005;Build 4
 ;;Per VA Directive 6402, this routine should not be modified
 ;
 Q
 ;
RDF(MSGROOT,CNT,LEN,HL) ;  Build RDF segment for Rx Profile data
 ;
 ;  Input:
 ;   MSGROOT - Root of array holding the message
 ;       CNT - Current message line counter
 ;       LEN - Current message length
 ;        HL - HL7 package array variable
 ;
 ;  Output:
 ;           - Populated message array
 ;           - Updated LEN and CNT
 ;
 N RDF
 S RDF(0)="RDF"
 S RDF(1)=65
 S RDF(2,1,1)="Prescription Number",RDF(2,1,2)="ST",RDF(2,1,3)=30
 S RDF(2,2,1)="IEN",RDF(2,2,2)="NM",RDF(2,2,3)=30
 S RDF(2,3,1)="Drug Name",RDF(2,3,2)="ST",RDF(2,3,3)=50
 S RDF(2,4,1)="Issue Date/Time",RDF(2,4,2)="TS",RDF(2,4,3)=26
 S RDF(2,5,1)="Last Fill Date",RDF(2,5,2)="TS",RDF(2,5,3)=26
 S RDF(2,6,1)="Release Date/Time",RDF(2,6,2)="TS",RDF(2,6,3)=26
 S RDF(2,7,1)="Expiration",RDF(2,7,2)="TS",RDF(2,7,3)=26
 S RDF(2,8,1)="Status",RDF(2,8,2)="ST",RDF(2,8,3)=25
 S RDF(2,9,1)="Quantity",RDF(2,9,2)="NM",RDF(2,9,3)=11
 S RDF(2,10,1)="Days Supply",RDF(2,10,2)="NM",RDF(2,10,3)=5
 S RDF(2,11,1)="Refills Remaining",RDF(2,11,2)="NM",RDF(2,11,3)=5
 S RDF(2,12,1)="Provider",RDF(2,12,2)="XCN",RDF(2,12,3)=150
 S RDF(2,13,1)="Placer Order Number",RDF(2,13,2)="ST",RDF(2,13,3)=30
 S RDF(2,14,1)="Mail/Window",RDF(2,14,2)="ST",RDF(2,14,3)=10
 S RDF(2,15,1)="Division",RDF(2,15,2)="NM",RDF(2,15,3)=50
 S RDF(2,16,1)="Division Name",RDF(2,16,2)="ST",RDF(2,16,3)=50
 S RDF(2,17,1)="MHV Refill Request Status",RDF(2,17,2)="NM",RDF(2,17,3)=5
 S RDF(2,18,1)="MHV Refill Request Status Date",RDF(2,18,2)="TS",RDF(2,18,3)=26
 S RDF(2,19,1)="Remarks",RDF(2,19,2)="ST",RDF(2,19,3)=1024
 S RDF(2,20,1)="Source",RDF(2,20,2)="ST",RDF(2,20,3)=2
 S RDF(2,21,1)="NDC",RDF(2,21,2)="ST",RDF(2,21,3)=15
 S RDF(2,22,1)="Dispensed Date",RDF(2,22,2)="TS",RDF(2,22,3)=26
 S RDF(2,23,1)="Trade Name",RDF(2,23,2)="ST",RDF(2,23,3)=30
 S RDF(2,24,1)="Reason",RDF(2,24,2)="ST",RDF(2,24,3)=100
 S RDF(2,25,1)="Reason Comment",RDF(2,25,2)="ST",RDF(2,25,3)=1024
 S RDF(2,26,1)="Cancel Date",RDF(2,26,2)="TS",RDF(2,26,3)=26
 S RDF(2,27,1)="Facility Site Number",RDF(2,27,2)="ST",RDF(2,27,3)=50
 S RDF(2,28,1)="Facility Name",RDF(2,28,2)="ST",RDF(2,28,3)=50
 S RDF(2,29,1)="Facility Address Line 1",RDF(2,29,2)="ST",RDF(2,29,3)=100
 S RDF(2,30,1)="Facility City",RDF(2,30,2)="ST",RDF(2,30,3)=60
 S RDF(2,31,1)="Facility State",RDF(2,31,2)="ST",RDF(2,31,3)=10
 S RDF(2,32,1)="Facility Zip",RDF(2,32,2)="ST",RDF(2,32,3)=10
 S RDF(2,33,1)="Facility Phone Number",RDF(2,33,2)="NM",RDF(2,33,3)=10
 S RDF(2,34,1)="Next Possible Fill Date",RDF(2,34,2)="TS",RDF(2,34,3)=26
 S RDF(2,35,1)="Drug Schedule",RDF(2,35,2)="ST",RDF(2,35,3)=50
 S RDF(2,36,1)="VAMC Tracking Number",RDF(2,36,2)="ST",RDF(2,36,3)=25
 S RDF(2,37,1)="CMOP Tracking Number",RDF(2,37,2)="ST",RDF(2,37,3)=25
 S RDF(2,38,1)="CMOP Date Shipped",RDF(2,38,2)="TS",RDF(2,38,3)=26
 S RDF(2,39,1)="CMOP Carrier",RDF(2,39,2)="ST",RDF(2,39,3)=50
 S RDF(2,40,1)="Carrier Tracking Number",RDF(2,40,2)="ST",RDF(2,40,3)=25
 S RDF(2,41,1)="Number of RX in Package",RDF(2,41,2)="NM",RDF(2,41,3)=5
 S RDF(2,42,1)="CMOP System",RDF(2,42,2)="ST",RDF(2,42,3)=50
 S RDF(2,43,1)="CMOP Status",RDF(2,43,2)="ST",RDF(2,43,3)=50
 S RDF(2,44,1)="CMOP RX Indicator",RDF(2,44,2)="ST",RDF(2,44,3)=5
 S RDF(2,45,1)="CMOP NDC Received",RDF(2,45,2)="ST",RDF(2,45,3)=15
 S RDF(2,46,1)="CMOP NDC Sent",RDF(2,46,2)="ST",RDF(2,46,3)=15
 S RDF(2,47,1)="Orderable Item",RDF(2,47,2)="ST",RDF(2,47,3)=30
 S RDF(2,48,1)="Administered At Clinic",RDF(2,48,2)="NM",RDF(2,48,3)=10
 S RDF(2,49,1)="Clinic/Hospital Location",RDF(2,49,2)="TX",RDF(2,49,3)=100
 S RDF(2,50,1)="UNIQUE INDEX",RDF(2,50,2)="TX",RDF(2,50,3)=10
 S RDF(2,51,1)="DISCLAIMER",RDF(2,51,2)="TX",RDF(2,51,3)=1024
 S RDF(2,52,1)="Last Refill Request Date",RDF(2,52,2)="TS",RDF(2,52,3)=26
 S RDF(2,53,1)="Last Refill Process Date",RDF(2,53,2)="TS",RDF(2,53,3)=26
 S RDF(2,54,1)="Last Refill Result",RDF(2,54,2)="ST",RDF(2,54,3)=15
 S RDF(2,55,1)="Last Refill Remark",RDF(2,55,2)="ST",RDF(2,55,3)=60
 S RDF(2,56,1)="Renewable Indicator",RDF(2,56,2)="ST",RDF(2,56,3)=2
 S RDF(2,57,1)="Not Renewable Reason",RDF(2,57,2)="ST",RDF(2,57,3)=100
 S RDF(2,58,1)="Renew Status",RDF(2,58,2)="ST",RDF(2,58,3)=2
 S RDF(2,59,1)="Renew Status Date",RDF(2,59,2)="TS",RDF(2,59,3)=26
 S RDF(2,60,1)="Renew Status Description",RDF(2,60,2)="ST",RDF(2,60,3)=100
 S RDF(2,61,1)="Renew Prescription Number",RDF(2,61,2)="ST",RDF(2,61,3)=30
 S RDF(2,62,1)="Indication for Use",RDF(2,62,2)="ST",RDF(2,62,3)=50
 S RDF(2,63,1)="Indication for Use Flag",RDF(2,63,2)="ST",RDF(2,63,3)=1
 S RDF(2,64,1)="Other Indication for Use",RDF(2,64,2)="ST",RDF(2,64,3)=50
 S RDF(2,65,1)="SIG",RDF(2,65,2)="TX",RDF(2,65,3)=1024
 ;
 S CNT=CNT+1
 S @MSGROOT@(CNT)=$$BLDSEG^MHV7U(.RDF,.HL)
 S LEN=LEN+$L(@MSGROOT@(CNT))
 Q
 ;
RDT(MSGROOT,DATAROOT,CNT,LEN,HL) ;  Build RDT segments for Rx Profile data
 ;
 ; Walks data in DATAROOT to populate MSGROOT with RDT segments
 ; sequentially numbered starting at CNT
 ;
 ;  Integration Agreements:
 ;        10103 : FMTHL7^XLFDT
 ;         3065 : HLNAME^XLFNAME
 ;
 ;  Input:
 ;   MSGROOT - Root of array holding the message
 ;  DATAROOT - Root of array to hold extract data
 ;       CNT - Current message line counter
 ;       LEN - Current message length
 ;        HL - HL7 package array variable
 ;
 ;  Output:
 ;           - Populated message array
 ;           - Updated LEN and CNT
 ;
 N I,CMP,DFN,DIV,RX,CMOP,RXP,RXN,RXN1,RXN2,RXN3,RXN4,RXD,RDT,SIG,SEG,PIEN,NAME,WPLEN,PHRM,RTXT,STXT,TXT,DTXT,REM,DISC,DFN
 ;N IX,SP,OUT,RFIEN,VAL,VAMC,BEGIN,CHAR,IND1,IND2,IND3,RENEWFLG,RENEWRSN
 D LOG^MHVUL2("MHV7B1R2","BEGIN RDT","S","TRACE")
 S INDFN=$G(@DATAROOT@(0))
 F I=1:1 Q:'$D(@DATAROOT@(I))  D
 . K RDT
 . S (RTXT,STXT,TXT)=""
 . S CMOP=$G(@DATAROOT@(I,"CMOP"))
 . S RX=$G(@DATAROOT@(I))
 . S RXN=$G(@DATAROOT@(I,"RXN"))
 . S RXN1=$G(@DATAROOT@(I,"RXN1"))
 . S RXN2=$G(@DATAROOT@(I,"RXN2"))
 . S RXN3=$G(@DATAROOT@(I,"RXN3"))
 . S RXN4=$G(@DATAROOT@(I,"RXN4"))
 . S PHRM=$G(@DATAROOT@(I,"PHRM"))
 . S RXP=$G(@DATAROOT@(I,"P"))
 . S PIEN=+RXP
 . S RXD=$G(@DATAROOT@(I,"DIV"))
 . ;K SIG I $D(@DATAROOT@(I,"SIG")) M SIG=@DATAROOT@(I,"SIG")
 . S RDT(0)="RDT"
 . S RDT(1)=$P(RX,"^")                         ;Rx Number
 . S RDT(2)=$P(RXN,"^")                        ;Rx IEN
 . ;S RDT(3)=$$ESCAPE^MHV7U($P(RXN,"^",2),.HL)  ;Drug Name  cfs Modified per Jira MHV-48168
 . S RDT(3)=$P(RXN,"^",2)  ;Drug Name
 . S RDT(4)=$$FMTHL7^XLFDT($P(RXN,"^",3))      ;Issue Date/Time
 . S RDT(5)=$$FMTHL7^XLFDT($P(RXN,"^",4))      ;Last Fill Date
 . S RDT(6)=$$FMTHL7^XLFDT($P(RXN,"^",5))      ;Release Date/Time
 . S RDT(7)=$$FMTHL7^XLFDT($P(RXN,"^",6))      ;Expiration
 . ;S RDT(8)=$$ESCAPE^MHV7U($P(RXN1,"^",1),.HL)  ;Status    cfs Modified per Jira MHV-48168
 . S RDT(8)=$P(RXN1,"^",1)  ;Status
 . S RDT(9)=$P(RXN1,"^",2)                      ;Quantity
 . S RDT(10)=$P(RXN1,"^",3)                     ;Days Supply
 . S RDT(11)=$P(RXN1,"^",4)                     ;Number of Refills
 . I PIEN D
 .. D FMTNAME2^MHV7BU(PIEN,200,.NAME,.HL,"XCN") ;Provider IEN
 .. M RDT(12,1)=NAME
 .. S RDT(12,1,1)=PIEN
 . ;S RDT(13)=$$ESCAPE^MHV7U($P(RXN1,"^",5),.HL)   ;Placer Order Number   cfs Modified per Jira MHV-48168
 . S RDT(13)=$P(RXN1,"^",5)   ;Placer Order Number 
 . S RDT(14)=$P(RXN1,"^",6)                       ;Mail/Window
 . S RDT(15)=$P(RXD,"^")                          ;Division
 . ;S RDT(16)=$$ESCAPE^MHV7U($P(RXD,"^",2),.HL)    ;Division Name   cfs Modified per Jira MHV-48168
 . S RDT(16)=$P(RXD,"^",2)   ;Division Name
 . S RDT(17)=$P(RX,"^",3)                         ;MHV status
 . S RDT(18)=$$FMTHL7^XLFDT($P(RX,"^",4))         ;MHV status date
 . ;Changed call to $$ESCAPE to used standard MHV7U
 . ;S RTXT=$$RMK("RMK")
 . ;S TXT=$$ESCAPE($E(RTXT,1,1024),.HL)            
 . ;S RDT(19)=$$SPACES(TXT)
 . ;S RDT(19)=$$SPACES($E($$ESCAPE^MHV7U($$RMK("RMK"),.HL),1,1024))     ;Remarks   cfs Modified per Jira MHV-48168
 . S RDT(19)=$$SPACES($E($$RMK("RMK"),1,1024))    ;Remarks
 . S RDT(20)=$P(RXN2,"^",1)                       ;Source
 . S RDT(21)=$P(RXN2,"^",2)                       ;NDC
 . S RDT(22)=$$FMTHL7^XLFDT($P(RXN2,"^",3))       ;Dispense Date
 . S RDT(23)=$P(RXN,"^",8)                        ;Trade Name
 . S RDT(24)=$P(RXN2,"^",4)                       ;Reason for Auto DC'ed: Rx Discontinued by EHRM Data Migration. -  Activity log.
 . S RDT(25)=$P(RXN2,"^",5)                       ;Auto DC'ed: Rx Discontinued by EHRM Data Migration.
 . S RDT(26)=$$FMTHL7^XLFDT($P(RXN2,"^",6))       ;Cancel Date
 . S RDT(27)=$P(PHRM,"^",8)    ;Site Number
 . S RDT(28)=$P(PHRM,"^",2)    ;Facility Name
 . S RDT(29)=$P(PHRM,"^",3)    ;Facility Address Line1
 . S RDT(30)=$P(PHRM,"^",5)    ;Facility City
 . S RDT(31)=$P(PHRM,"^",7)    ;Facility State
 . S RDT(32)=$P(PHRM,"^",6)    ;Facility Zip
 . S RDT(33)=$P(PHRM,"^",4)    ;Facility Phone
 . S RDT(34)=$$FMTHL7^XLFDT($P(RXN3,"^",2))    ;Refilliable Date
 . S RDT(35)=$P(RXN3,"^",3)    ;Drug Schedule 
 . S RDT(36)=$P(RXN3,"^",4)    ;Other Tracking Number pulled from activity log
 . S RDT(37)=$P(CMOP,"^",11)   ;CMOP Tracking Number
 . S RDT(38)=$$FMTHL7^XLFDT($P(CMOP,"^",9))    ;CMOP Date Shipped
 . S RDT(39)=$P(CMOP,"^",10)   ;CMOP Carrier
 . S RDT(40)=""   ;Carrier Tracking Number <FUTURE USE>
 . S RDT(41)=""   ;Number of RX in Package <FUTURE USE>
 . S RDT(42)=""   ;CMOP System <FUTURE USE>
 . S RDT(43)=$P(CMOP,"^",3)    ;CMOP Status
 . S RDT(44)=$P(CMOP,"^",2)    ;CMOP Rx Indicator
 . S RDT(45)=$P(CMOP,"^",4)    ;CMOP NDC Received
 . S RDT(46)=$P(CMOP,"^",12)   ;CMOP NDC Sent
 . S RDT(47)=$P(RXN3,"^",5)    ;Orderable Item
 . S RDT(48)=$P(RXN3,"^",6)    ;Administered at Clinic
 . s RDT(49)=$P(RXN3,"^",1)    ;Clinic
 . S RDT(50)=$P(RXN1,"^",7)    ;UNIQUE INDEX FOR RF AND PF
 . S RDT(51)=""
 . I RDT(20)="NV" D
 . .S DISC=$$RMK("DSC")        ;DISCLAIMER FOR NONVA
 . .S REM=$$RMK("RMK")
 . .S DTXT=$P(DISC,REM,1)
 . .;Fixed to call MHV7U escape utility jbm 07-07-2021
 . .;S TXT=$$ESCAPE($E(DTXT,1,1024),.HL)
 . .;S RDT(52)=$$SPACES(TXT)
 . .;S RDT(51)=$$SPACES($E($$ESCAPE^MHV7U(DTXT,.HL),1,1024))   ;cfs Modified per Jira MHV-48168
 . .S RDT(51)=$$SPACES($E(DTXT,1,1024))
 . D RQUEUE
 . S RDT(52)=$P($$FMTHL7^XLFDT($G(RQARR(11,"I"))),"-",1)  ;Queue 52.43 - LOGIN DATE
 . S RDT(53)=$P($$FMTHL7^XLFDT($G(RQARR(5,"I"))),"-",1)   ;Queue 52.43 - PROCESS DATE
 . S RDT(54)=$G(RQARR(6,"E"))       ;Queue 52.43 - RESULT
 . S RDT(55)=$G(RQARR(10,"E"))      ;Queue 52.43 - REMARK
 . S RENEWFLG=0,RENEWRSN=""
 . ;Only Check renewable if source is RX or RF
 . I $P(RXN2,"^",1)="RX"!($P(RXN2,"^",1)="RF") D
 . . S DFN=+$P($G(^PSRX($P(RXN,"^"),0)),"^",2)
 . . Q:'DFN
 . . S X=$$RENWCHK^MHVPRNA(DFN,$P(RXN,"^")),RENEWFLG=+X,RENEWRSN=$P(X,"^",2)
 . S RDT(56)=RENEWFLG
 . S RDT(57)=RENEWRSN
 . S RDT(58)=""   ;phase 2
 . S RDT(59)=""   ;phase 2
 . S RDT(60)=""   ;phase 2
 . S RDT(61)=""   ;phase 2
 . D GETIND
 . S RDT(62)=IND1
 . S RDT(63)=IND2
 . S RDT(64)=IND3
 . ;S RDT(65)=$$SPACES($E($$ESCAPE^MHV7U($$RMK("SIG"),.HL),1,1024))    ;Sig    cfs Modified per Jira MHV-48168
 . S RDT(65)=$$SPACES($E($$RMK("SIG"),1,1024))   ;Sig
 . ;cfs 08/23/2023 - Call the Escape Character Function on the array RDT and escape all fields. Jira MHV-48168
 . N LASTRDT,INDX
 . S LASTRDT="" S LASTRDT=$O(RDT(LASTRDT),-1) ;Get the last index of the RDT array.
 . F INDX=1:1:LASTRDT I $G(RDT(INDX))'="" S RDT(INDX)=$$ESCAPE^MHV7U(RDT(INDX),.HL)
 . S CNT=CNT+1
 . S @MSGROOT@(CNT)=$$STRIP($$BLDSEG^MHV7U(.RDT,.HL))
 . S LEN=LEN+$L(@MSGROOT@(CNT))
 . Q
 D LOG^MHVUL2("MHV7B1R2","END RDT","S","TRACE")
 Q
RQUEUE ;Get last record from refill queue file 52.43
 N RFIEN,QARR
 K RQARR
 S RFIEN=$O(^PS(52.43,"AE",$P(RXN,"^"),""),-1)
 Q:RFIEN=""
 Do GETS^DIQ(52.43,RFIEN_",","5;6;10;11","IE","QARR")
 I $D(QARR) M RQARR=QARR(52.43,RFIEN_",")
 Q 
 ;
RMK(TYP) ; build Remark field
 N X,Y
 S X="",Y=0
 F  S Y=$O(@DATAROOT@(I,TYP,Y)) Q:'Y  D
 .Q:$G(@DATAROOT@(I,TYP,Y,0))=""
 .S:X]"" X=X_" "
 .S X=X_@DATAROOT@(I,TYP,Y,0)
 Q X
SPACES(WPN) ; Remove extra spaces from line of text
 N OUT,IX,SP
 S OUT=WPN
 S SP=" "
 F IX=$L(OUT):-1:1 I ($E(OUT,IX,IX+1)=(SP_SP)) S $E(OUT,IX)=""
 Q OUT
 ;
GETIND ;Get indication fields
 N IENVAL,SRC,VAL
 S (IND1,IND2,IND3)=""
 S IENVAL=$P(RXN,"^")
 Q:IENVAL=""
 S SRC=$P(RXN2,"^",1)
 Q:SRC=""
 I SRC="RX"!(SRC="RF")!(SRC="PF") D  Q
 .S VAL=$G(^PSRX(IENVAL,"IND"))
 .S IND1=$P(VAL,"^",1)
 .S IND2=$P(VAL,"^",2)
 .S IND3=$P(VAL,"^",3)
 I SRC="NV" D  Q
 .Q:INDFN=""
 .S IND1=$P($G(^PS(55,INDFN,"NVA",IENVAL,2)),"^",1)
 I SRC="PD" D  Q
 .S IND1=$P($G(^PS(52.41,IENVAL,4)),"^",2)
 Q
 ;Create utility to strip all ascii from RDT segment
STRIP(HL7STR) ; Remove bad ascii characters from HL7 line
 N OUT,POS,CHAR
 S OUT=""
 F POS=1:1:$L(HL7STR) S CHAR=$E(HL7STR,POS) I $A(CHAR)>31 S OUT=OUT_CHAR
 Q OUT
ESCAPE(VAL,HL) ;Escape any special characters
 ;
 ;  Input:
 ;    VAL - value to escape
 ;     HL - HL7 environment array
 ;
 ;  Output:
 ;    VAL - passed by reference
 ;
 N FS      ;field separator
 N CS      ;component separator
 N RS      ;repetition separator
 N ES      ;escape character
 N SS      ;sub-component separator
 N L,STR,I
 ;
 S FS=HL("FS")
 S CS=$E(HL("ECH"))
 S RS=$E(HL("ECH"),2)
 S ES=$E(HL("ECH"),3)
 S SS=$E(HL("ECH"),4)
 ;
 I VAL[ES D
 . S L=$L(VAL,ES),STR=""
 . F I=1:1:L S $P(STR," ",I)=$P(VAL,ES,I)
 . S VAL=STR
 I VAL[FS D
 . S L=$L(VAL,FS),STR=""
 . F I=1:1:L S $P(STR," ",I)=$P(VAL,FS,I)
 . S VAL=STR
 I VAL[RS D
 . S L=$L(VAL,RS),STR=""
 . F I=1:1:L S $P(STR," ",I)=$P(VAL,RS,I)
 . S VAL=STR
 I VAL[CS D
 . S L=$L(VAL,CS),STR=""
 . F I=1:1:L S $P(STR," ",I)=$P(VAL,CS,I)
 . S VAL=STR
 I VAL[SS D
 . S L=$L(VAL,SS),STR=""
 . F I=1:1:L S $P(STR," ",I)=$P(VAL,SS,I)
 . S VAL=STR
 Q VAL
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMHV7B1R2   14107     printed  Sep 23, 2025@19:51:47                                                                                                                                                                                                   Page 2
MHV7B1R2  ;MHV/JBM - HL7 message builder RTB^K13 Medications Profile ; 02/07/22
 +1       ;;1.0;My HealtheVet;**74,91**;Aug 23, 2005;Build 4
 +2       ;;Per VA Directive 6402, this routine should not be modified
 +3       ;
 +4        QUIT 
 +5       ;
RDF(MSGROOT,CNT,LEN,HL) ;  Build RDF segment for Rx Profile data
 +1       ;
 +2       ;  Input:
 +3       ;   MSGROOT - Root of array holding the message
 +4       ;       CNT - Current message line counter
 +5       ;       LEN - Current message length
 +6       ;        HL - HL7 package array variable
 +7       ;
 +8       ;  Output:
 +9       ;           - Populated message array
 +10      ;           - Updated LEN and CNT
 +11      ;
 +12       NEW RDF
 +13       SET RDF(0)="RDF"
 +14       SET RDF(1)=65
 +15       SET RDF(2,1,1)="Prescription Number"
           SET RDF(2,1,2)="ST"
           SET RDF(2,1,3)=30
 +16       SET RDF(2,2,1)="IEN"
           SET RDF(2,2,2)="NM"
           SET RDF(2,2,3)=30
 +17       SET RDF(2,3,1)="Drug Name"
           SET RDF(2,3,2)="ST"
           SET RDF(2,3,3)=50
 +18       SET RDF(2,4,1)="Issue Date/Time"
           SET RDF(2,4,2)="TS"
           SET RDF(2,4,3)=26
 +19       SET RDF(2,5,1)="Last Fill Date"
           SET RDF(2,5,2)="TS"
           SET RDF(2,5,3)=26
 +20       SET RDF(2,6,1)="Release Date/Time"
           SET RDF(2,6,2)="TS"
           SET RDF(2,6,3)=26
 +21       SET RDF(2,7,1)="Expiration"
           SET RDF(2,7,2)="TS"
           SET RDF(2,7,3)=26
 +22       SET RDF(2,8,1)="Status"
           SET RDF(2,8,2)="ST"
           SET RDF(2,8,3)=25
 +23       SET RDF(2,9,1)="Quantity"
           SET RDF(2,9,2)="NM"
           SET RDF(2,9,3)=11
 +24       SET RDF(2,10,1)="Days Supply"
           SET RDF(2,10,2)="NM"
           SET RDF(2,10,3)=5
 +25       SET RDF(2,11,1)="Refills Remaining"
           SET RDF(2,11,2)="NM"
           SET RDF(2,11,3)=5
 +26       SET RDF(2,12,1)="Provider"
           SET RDF(2,12,2)="XCN"
           SET RDF(2,12,3)=150
 +27       SET RDF(2,13,1)="Placer Order Number"
           SET RDF(2,13,2)="ST"
           SET RDF(2,13,3)=30
 +28       SET RDF(2,14,1)="Mail/Window"
           SET RDF(2,14,2)="ST"
           SET RDF(2,14,3)=10
 +29       SET RDF(2,15,1)="Division"
           SET RDF(2,15,2)="NM"
           SET RDF(2,15,3)=50
 +30       SET RDF(2,16,1)="Division Name"
           SET RDF(2,16,2)="ST"
           SET RDF(2,16,3)=50
 +31       SET RDF(2,17,1)="MHV Refill Request Status"
           SET RDF(2,17,2)="NM"
           SET RDF(2,17,3)=5
 +32       SET RDF(2,18,1)="MHV Refill Request Status Date"
           SET RDF(2,18,2)="TS"
           SET RDF(2,18,3)=26
 +33       SET RDF(2,19,1)="Remarks"
           SET RDF(2,19,2)="ST"
           SET RDF(2,19,3)=1024
 +34       SET RDF(2,20,1)="Source"
           SET RDF(2,20,2)="ST"
           SET RDF(2,20,3)=2
 +35       SET RDF(2,21,1)="NDC"
           SET RDF(2,21,2)="ST"
           SET RDF(2,21,3)=15
 +36       SET RDF(2,22,1)="Dispensed Date"
           SET RDF(2,22,2)="TS"
           SET RDF(2,22,3)=26
 +37       SET RDF(2,23,1)="Trade Name"
           SET RDF(2,23,2)="ST"
           SET RDF(2,23,3)=30
 +38       SET RDF(2,24,1)="Reason"
           SET RDF(2,24,2)="ST"
           SET RDF(2,24,3)=100
 +39       SET RDF(2,25,1)="Reason Comment"
           SET RDF(2,25,2)="ST"
           SET RDF(2,25,3)=1024
 +40       SET RDF(2,26,1)="Cancel Date"
           SET RDF(2,26,2)="TS"
           SET RDF(2,26,3)=26
 +41       SET RDF(2,27,1)="Facility Site Number"
           SET RDF(2,27,2)="ST"
           SET RDF(2,27,3)=50
 +42       SET RDF(2,28,1)="Facility Name"
           SET RDF(2,28,2)="ST"
           SET RDF(2,28,3)=50
 +43       SET RDF(2,29,1)="Facility Address Line 1"
           SET RDF(2,29,2)="ST"
           SET RDF(2,29,3)=100
 +44       SET RDF(2,30,1)="Facility City"
           SET RDF(2,30,2)="ST"
           SET RDF(2,30,3)=60
 +45       SET RDF(2,31,1)="Facility State"
           SET RDF(2,31,2)="ST"
           SET RDF(2,31,3)=10
 +46       SET RDF(2,32,1)="Facility Zip"
           SET RDF(2,32,2)="ST"
           SET RDF(2,32,3)=10
 +47       SET RDF(2,33,1)="Facility Phone Number"
           SET RDF(2,33,2)="NM"
           SET RDF(2,33,3)=10
 +48       SET RDF(2,34,1)="Next Possible Fill Date"
           SET RDF(2,34,2)="TS"
           SET RDF(2,34,3)=26
 +49       SET RDF(2,35,1)="Drug Schedule"
           SET RDF(2,35,2)="ST"
           SET RDF(2,35,3)=50
 +50       SET RDF(2,36,1)="VAMC Tracking Number"
           SET RDF(2,36,2)="ST"
           SET RDF(2,36,3)=25
 +51       SET RDF(2,37,1)="CMOP Tracking Number"
           SET RDF(2,37,2)="ST"
           SET RDF(2,37,3)=25
 +52       SET RDF(2,38,1)="CMOP Date Shipped"
           SET RDF(2,38,2)="TS"
           SET RDF(2,38,3)=26
 +53       SET RDF(2,39,1)="CMOP Carrier"
           SET RDF(2,39,2)="ST"
           SET RDF(2,39,3)=50
 +54       SET RDF(2,40,1)="Carrier Tracking Number"
           SET RDF(2,40,2)="ST"
           SET RDF(2,40,3)=25
 +55       SET RDF(2,41,1)="Number of RX in Package"
           SET RDF(2,41,2)="NM"
           SET RDF(2,41,3)=5
 +56       SET RDF(2,42,1)="CMOP System"
           SET RDF(2,42,2)="ST"
           SET RDF(2,42,3)=50
 +57       SET RDF(2,43,1)="CMOP Status"
           SET RDF(2,43,2)="ST"
           SET RDF(2,43,3)=50
 +58       SET RDF(2,44,1)="CMOP RX Indicator"
           SET RDF(2,44,2)="ST"
           SET RDF(2,44,3)=5
 +59       SET RDF(2,45,1)="CMOP NDC Received"
           SET RDF(2,45,2)="ST"
           SET RDF(2,45,3)=15
 +60       SET RDF(2,46,1)="CMOP NDC Sent"
           SET RDF(2,46,2)="ST"
           SET RDF(2,46,3)=15
 +61       SET RDF(2,47,1)="Orderable Item"
           SET RDF(2,47,2)="ST"
           SET RDF(2,47,3)=30
 +62       SET RDF(2,48,1)="Administered At Clinic"
           SET RDF(2,48,2)="NM"
           SET RDF(2,48,3)=10
 +63       SET RDF(2,49,1)="Clinic/Hospital Location"
           SET RDF(2,49,2)="TX"
           SET RDF(2,49,3)=100
 +64       SET RDF(2,50,1)="UNIQUE INDEX"
           SET RDF(2,50,2)="TX"
           SET RDF(2,50,3)=10
 +65       SET RDF(2,51,1)="DISCLAIMER"
           SET RDF(2,51,2)="TX"
           SET RDF(2,51,3)=1024
 +66       SET RDF(2,52,1)="Last Refill Request Date"
           SET RDF(2,52,2)="TS"
           SET RDF(2,52,3)=26
 +67       SET RDF(2,53,1)="Last Refill Process Date"
           SET RDF(2,53,2)="TS"
           SET RDF(2,53,3)=26
 +68       SET RDF(2,54,1)="Last Refill Result"
           SET RDF(2,54,2)="ST"
           SET RDF(2,54,3)=15
 +69       SET RDF(2,55,1)="Last Refill Remark"
           SET RDF(2,55,2)="ST"
           SET RDF(2,55,3)=60
 +70       SET RDF(2,56,1)="Renewable Indicator"
           SET RDF(2,56,2)="ST"
           SET RDF(2,56,3)=2
 +71       SET RDF(2,57,1)="Not Renewable Reason"
           SET RDF(2,57,2)="ST"
           SET RDF(2,57,3)=100
 +72       SET RDF(2,58,1)="Renew Status"
           SET RDF(2,58,2)="ST"
           SET RDF(2,58,3)=2
 +73       SET RDF(2,59,1)="Renew Status Date"
           SET RDF(2,59,2)="TS"
           SET RDF(2,59,3)=26
 +74       SET RDF(2,60,1)="Renew Status Description"
           SET RDF(2,60,2)="ST"
           SET RDF(2,60,3)=100
 +75       SET RDF(2,61,1)="Renew Prescription Number"
           SET RDF(2,61,2)="ST"
           SET RDF(2,61,3)=30
 +76       SET RDF(2,62,1)="Indication for Use"
           SET RDF(2,62,2)="ST"
           SET RDF(2,62,3)=50
 +77       SET RDF(2,63,1)="Indication for Use Flag"
           SET RDF(2,63,2)="ST"
           SET RDF(2,63,3)=1
 +78       SET RDF(2,64,1)="Other Indication for Use"
           SET RDF(2,64,2)="ST"
           SET RDF(2,64,3)=50
 +79       SET RDF(2,65,1)="SIG"
           SET RDF(2,65,2)="TX"
           SET RDF(2,65,3)=1024
 +80      ;
 +81       SET CNT=CNT+1
 +82       SET @MSGROOT@(CNT)=$$BLDSEG^MHV7U(.RDF,.HL)
 +83       SET LEN=LEN+$LENGTH(@MSGROOT@(CNT))
 +84       QUIT 
 +85      ;
RDT(MSGROOT,DATAROOT,CNT,LEN,HL) ;  Build RDT segments for Rx Profile data
 +1       ;
 +2       ; Walks data in DATAROOT to populate MSGROOT with RDT segments
 +3       ; sequentially numbered starting at CNT
 +4       ;
 +5       ;  Integration Agreements:
 +6       ;        10103 : FMTHL7^XLFDT
 +7       ;         3065 : HLNAME^XLFNAME
 +8       ;
 +9       ;  Input:
 +10      ;   MSGROOT - Root of array holding the message
 +11      ;  DATAROOT - Root of array to hold extract data
 +12      ;       CNT - Current message line counter
 +13      ;       LEN - Current message length
 +14      ;        HL - HL7 package array variable
 +15      ;
 +16      ;  Output:
 +17      ;           - Populated message array
 +18      ;           - Updated LEN and CNT
 +19      ;
 +20       NEW I,CMP,DFN,DIV,RX,CMOP,RXP,RXN,RXN1,RXN2,RXN3,RXN4,RXD,RDT,SIG,SEG,PIEN,NAME,WPLEN,PHRM,RTXT,STXT,TXT,DTXT,REM,DISC,DFN
 +21      ;N IX,SP,OUT,RFIEN,VAL,VAMC,BEGIN,CHAR,IND1,IND2,IND3,RENEWFLG,RENEWRSN
 +22       DO LOG^MHVUL2("MHV7B1R2","BEGIN RDT","S","TRACE")
 +23       SET INDFN=$GET(@DATAROOT@(0))
 +24       FOR I=1:1
               if '$DATA(@DATAROOT@(I))
                   QUIT 
               Begin DoDot:1
 +25               KILL RDT
 +26               SET (RTXT,STXT,TXT)=""
 +27               SET CMOP=$GET(@DATAROOT@(I,"CMOP"))
 +28               SET RX=$GET(@DATAROOT@(I))
 +29               SET RXN=$GET(@DATAROOT@(I,"RXN"))
 +30               SET RXN1=$GET(@DATAROOT@(I,"RXN1"))
 +31               SET RXN2=$GET(@DATAROOT@(I,"RXN2"))
 +32               SET RXN3=$GET(@DATAROOT@(I,"RXN3"))
 +33               SET RXN4=$GET(@DATAROOT@(I,"RXN4"))
 +34               SET PHRM=$GET(@DATAROOT@(I,"PHRM"))
 +35               SET RXP=$GET(@DATAROOT@(I,"P"))
 +36               SET PIEN=+RXP
 +37               SET RXD=$GET(@DATAROOT@(I,"DIV"))
 +38      ;K SIG I $D(@DATAROOT@(I,"SIG")) M SIG=@DATAROOT@(I,"SIG")
 +39               SET RDT(0)="RDT"
 +40      ;Rx Number
                   SET RDT(1)=$PIECE(RX,"^")
 +41      ;Rx IEN
                   SET RDT(2)=$PIECE(RXN,"^")
 +42      ;S RDT(3)=$$ESCAPE^MHV7U($P(RXN,"^",2),.HL)  ;Drug Name  cfs Modified per Jira MHV-48168
 +43      ;Drug Name
                   SET RDT(3)=$PIECE(RXN,"^",2)
 +44      ;Issue Date/Time
                   SET RDT(4)=$$FMTHL7^XLFDT($PIECE(RXN,"^",3))
 +45      ;Last Fill Date
                   SET RDT(5)=$$FMTHL7^XLFDT($PIECE(RXN,"^",4))
 +46      ;Release Date/Time
                   SET RDT(6)=$$FMTHL7^XLFDT($PIECE(RXN,"^",5))
 +47      ;Expiration
                   SET RDT(7)=$$FMTHL7^XLFDT($PIECE(RXN,"^",6))
 +48      ;S RDT(8)=$$ESCAPE^MHV7U($P(RXN1,"^",1),.HL)  ;Status    cfs Modified per Jira MHV-48168
 +49      ;Status
                   SET RDT(8)=$PIECE(RXN1,"^",1)
 +50      ;Quantity
                   SET RDT(9)=$PIECE(RXN1,"^",2)
 +51      ;Days Supply
                   SET RDT(10)=$PIECE(RXN1,"^",3)
 +52      ;Number of Refills
                   SET RDT(11)=$PIECE(RXN1,"^",4)
 +53               IF PIEN
                       Begin DoDot:2
 +54      ;Provider IEN
                           DO FMTNAME2^MHV7BU(PIEN,200,.NAME,.HL,"XCN")
 +55                       MERGE RDT(12,1)=NAME
 +56                       SET RDT(12,1,1)=PIEN
                       End DoDot:2
 +57      ;S RDT(13)=$$ESCAPE^MHV7U($P(RXN1,"^",5),.HL)   ;Placer Order Number   cfs Modified per Jira MHV-48168
 +58      ;Placer Order Number 
                   SET RDT(13)=$PIECE(RXN1,"^",5)
 +59      ;Mail/Window
                   SET RDT(14)=$PIECE(RXN1,"^",6)
 +60      ;Division
                   SET RDT(15)=$PIECE(RXD,"^")
 +61      ;S RDT(16)=$$ESCAPE^MHV7U($P(RXD,"^",2),.HL)    ;Division Name   cfs Modified per Jira MHV-48168
 +62      ;Division Name
                   SET RDT(16)=$PIECE(RXD,"^",2)
 +63      ;MHV status
                   SET RDT(17)=$PIECE(RX,"^",3)
 +64      ;MHV status date
                   SET RDT(18)=$$FMTHL7^XLFDT($PIECE(RX,"^",4))
 +65      ;Changed call to $$ESCAPE to used standard MHV7U
 +66      ;S RTXT=$$RMK("RMK")
 +67      ;S TXT=$$ESCAPE($E(RTXT,1,1024),.HL)            
 +68      ;S RDT(19)=$$SPACES(TXT)
 +69      ;S RDT(19)=$$SPACES($E($$ESCAPE^MHV7U($$RMK("RMK"),.HL),1,1024))     ;Remarks   cfs Modified per Jira MHV-48168
 +70      ;Remarks
                   SET RDT(19)=$$SPACES($EXTRACT($$RMK("RMK"),1,1024))
 +71      ;Source
                   SET RDT(20)=$PIECE(RXN2,"^",1)
 +72      ;NDC
                   SET RDT(21)=$PIECE(RXN2,"^",2)
 +73      ;Dispense Date
                   SET RDT(22)=$$FMTHL7^XLFDT($PIECE(RXN2,"^",3))
 +74      ;Trade Name
                   SET RDT(23)=$PIECE(RXN,"^",8)
 +75      ;Reason for Auto DC'ed: Rx Discontinued by EHRM Data Migration. -  Activity log.
                   SET RDT(24)=$PIECE(RXN2,"^",4)
 +76      ;Auto DC'ed: Rx Discontinued by EHRM Data Migration.
                   SET RDT(25)=$PIECE(RXN2,"^",5)
 +77      ;Cancel Date
                   SET RDT(26)=$$FMTHL7^XLFDT($PIECE(RXN2,"^",6))
 +78      ;Site Number
                   SET RDT(27)=$PIECE(PHRM,"^",8)
 +79      ;Facility Name
                   SET RDT(28)=$PIECE(PHRM,"^",2)
 +80      ;Facility Address Line1
                   SET RDT(29)=$PIECE(PHRM,"^",3)
 +81      ;Facility City
                   SET RDT(30)=$PIECE(PHRM,"^",5)
 +82      ;Facility State
                   SET RDT(31)=$PIECE(PHRM,"^",7)
 +83      ;Facility Zip
                   SET RDT(32)=$PIECE(PHRM,"^",6)
 +84      ;Facility Phone
                   SET RDT(33)=$PIECE(PHRM,"^",4)
 +85      ;Refilliable Date
                   SET RDT(34)=$$FMTHL7^XLFDT($PIECE(RXN3,"^",2))
 +86      ;Drug Schedule 
                   SET RDT(35)=$PIECE(RXN3,"^",3)
 +87      ;Other Tracking Number pulled from activity log
                   SET RDT(36)=$PIECE(RXN3,"^",4)
 +88      ;CMOP Tracking Number
                   SET RDT(37)=$PIECE(CMOP,"^",11)
 +89      ;CMOP Date Shipped
                   SET RDT(38)=$$FMTHL7^XLFDT($PIECE(CMOP,"^",9))
 +90      ;CMOP Carrier
                   SET RDT(39)=$PIECE(CMOP,"^",10)
 +91      ;Carrier Tracking Number <FUTURE USE>
                   SET RDT(40)=""
 +92      ;Number of RX in Package <FUTURE USE>
                   SET RDT(41)=""
 +93      ;CMOP System <FUTURE USE>
                   SET RDT(42)=""
 +94      ;CMOP Status
                   SET RDT(43)=$PIECE(CMOP,"^",3)
 +95      ;CMOP Rx Indicator
                   SET RDT(44)=$PIECE(CMOP,"^",2)
 +96      ;CMOP NDC Received
                   SET RDT(45)=$PIECE(CMOP,"^",4)
 +97      ;CMOP NDC Sent
                   SET RDT(46)=$PIECE(CMOP,"^",12)
 +98      ;Orderable Item
                   SET RDT(47)=$PIECE(RXN3,"^",5)
 +99      ;Administered at Clinic
                   SET RDT(48)=$PIECE(RXN3,"^",6)
 +100     ;Clinic
                   SET RDT(49)=$PIECE(RXN3,"^",1)
 +101     ;UNIQUE INDEX FOR RF AND PF
                   SET RDT(50)=$PIECE(RXN1,"^",7)
 +102              SET RDT(51)=""
 +103              IF RDT(20)="NV"
                       Begin DoDot:2
 +104     ;DISCLAIMER FOR NONVA
                           SET DISC=$$RMK("DSC")
 +105                      SET REM=$$RMK("RMK")
 +106                      SET DTXT=$PIECE(DISC,REM,1)
 +107     ;Fixed to call MHV7U escape utility jbm 07-07-2021
 +108     ;S TXT=$$ESCAPE($E(DTXT,1,1024),.HL)
 +109     ;S RDT(52)=$$SPACES(TXT)
 +110     ;S RDT(51)=$$SPACES($E($$ESCAPE^MHV7U(DTXT,.HL),1,1024))   ;cfs Modified per Jira MHV-48168
 +111                      SET RDT(51)=$$SPACES($EXTRACT(DTXT,1,1024))
                       End DoDot:2
 +112              DO RQUEUE
 +113     ;Queue 52.43 - LOGIN DATE
                   SET RDT(52)=$PIECE($$FMTHL7^XLFDT($GET(RQARR(11,"I"))),"-",1)
 +114     ;Queue 52.43 - PROCESS DATE
                   SET RDT(53)=$PIECE($$FMTHL7^XLFDT($GET(RQARR(5,"I"))),"-",1)
 +115     ;Queue 52.43 - RESULT
                   SET RDT(54)=$GET(RQARR(6,"E"))
 +116     ;Queue 52.43 - REMARK
                   SET RDT(55)=$GET(RQARR(10,"E"))
 +117              SET RENEWFLG=0
                   SET RENEWRSN=""
 +118     ;Only Check renewable if source is RX or RF
 +119              IF $PIECE(RXN2,"^",1)="RX"!($PIECE(RXN2,"^",1)="RF")
                       Begin DoDot:2
 +120                      SET DFN=+$PIECE($GET(^PSRX($PIECE(RXN,"^"),0)),"^",2)
 +121                      if 'DFN
                               QUIT 
 +122                      SET X=$$RENWCHK^MHVPRNA(DFN,$PIECE(RXN,"^"))
                           SET RENEWFLG=+X
                           SET RENEWRSN=$PIECE(X,"^",2)
                       End DoDot:2
 +123              SET RDT(56)=RENEWFLG
 +124              SET RDT(57)=RENEWRSN
 +125     ;phase 2
                   SET RDT(58)=""
 +126     ;phase 2
                   SET RDT(59)=""
 +127     ;phase 2
                   SET RDT(60)=""
 +128     ;phase 2
                   SET RDT(61)=""
 +129              DO GETIND
 +130              SET RDT(62)=IND1
 +131              SET RDT(63)=IND2
 +132              SET RDT(64)=IND3
 +133     ;S RDT(65)=$$SPACES($E($$ESCAPE^MHV7U($$RMK("SIG"),.HL),1,1024))    ;Sig    cfs Modified per Jira MHV-48168
 +134     ;Sig
                   SET RDT(65)=$$SPACES($EXTRACT($$RMK("SIG"),1,1024))
 +135     ;cfs 08/23/2023 - Call the Escape Character Function on the array RDT and escape all fields. Jira MHV-48168
 +136              NEW LASTRDT,INDX
 +137     ;Get the last index of the RDT array.
                   SET LASTRDT=""
                   SET LASTRDT=$ORDER(RDT(LASTRDT),-1)
 +138              FOR INDX=1:1:LASTRDT
                       IF $GET(RDT(INDX))'=""
                           SET RDT(INDX)=$$ESCAPE^MHV7U(RDT(INDX),.HL)
 +139              SET CNT=CNT+1
 +140              SET @MSGROOT@(CNT)=$$STRIP($$BLDSEG^MHV7U(.RDT,.HL))
 +141              SET LEN=LEN+$LENGTH(@MSGROOT@(CNT))
 +142              QUIT 
               End DoDot:1
 +143      DO LOG^MHVUL2("MHV7B1R2","END RDT","S","TRACE")
 +144      QUIT 
RQUEUE    ;Get last record from refill queue file 52.43
 +1        NEW RFIEN,QARR
 +2        KILL RQARR
 +3        SET RFIEN=$ORDER(^PS(52.43,"AE",$PIECE(RXN,"^"),""),-1)
 +4        if RFIEN=""
               QUIT 
 +5        DO GETS^DIQ(52.43,RFIEN_",","5;6;10;11","IE","QARR")
 +6        IF $DATA(QARR)
               MERGE RQARR=QARR(52.43,RFIEN_",")
 +7        QUIT 
 +8       ;
RMK(TYP)  ; build Remark field
 +1        NEW X,Y
 +2        SET X=""
           SET Y=0
 +3        FOR 
               SET Y=$ORDER(@DATAROOT@(I,TYP,Y))
               if 'Y
                   QUIT 
               Begin DoDot:1
 +4                if $GET(@DATAROOT@(I,TYP,Y,0))=""
                       QUIT 
 +5                if X]""
                       SET X=X_" "
 +6                SET X=X_@DATAROOT@(I,TYP,Y,0)
               End DoDot:1
 +7        QUIT X
SPACES(WPN) ; Remove extra spaces from line of text
 +1        NEW OUT,IX,SP
 +2        SET OUT=WPN
 +3        SET SP=" "
 +4        FOR IX=$LENGTH(OUT):-1:1
               IF ($EXTRACT(OUT,IX,IX+1)=(SP_SP))
                   SET $EXTRACT(OUT,IX)=""
 +5        QUIT OUT
 +6       ;
GETIND    ;Get indication fields
 +1        NEW IENVAL,SRC,VAL
 +2        SET (IND1,IND2,IND3)=""
 +3        SET IENVAL=$PIECE(RXN,"^")
 +4        if IENVAL=""
               QUIT 
 +5        SET SRC=$PIECE(RXN2,"^",1)
 +6        if SRC=""
               QUIT 
 +7        IF SRC="RX"!(SRC="RF")!(SRC="PF")
               Begin DoDot:1
 +8                SET VAL=$GET(^PSRX(IENVAL,"IND"))
 +9                SET IND1=$PIECE(VAL,"^",1)
 +10               SET IND2=$PIECE(VAL,"^",2)
 +11               SET IND3=$PIECE(VAL,"^",3)
               End DoDot:1
               QUIT 
 +12       IF SRC="NV"
               Begin DoDot:1
 +13               if INDFN=""
                       QUIT 
 +14               SET IND1=$PIECE($GET(^PS(55,INDFN,"NVA",IENVAL,2)),"^",1)
               End DoDot:1
               QUIT 
 +15       IF SRC="PD"
               Begin DoDot:1
 +16               SET IND1=$PIECE($GET(^PS(52.41,IENVAL,4)),"^",2)
               End DoDot:1
               QUIT 
 +17       QUIT 
 +18      ;Create utility to strip all ascii from RDT segment
STRIP(HL7STR) ; Remove bad ascii characters from HL7 line
 +1        NEW OUT,POS,CHAR
 +2        SET OUT=""
 +3        FOR POS=1:1:$LENGTH(HL7STR)
               SET CHAR=$EXTRACT(HL7STR,POS)
               IF $ASCII(CHAR)>31
                   SET OUT=OUT_CHAR
 +4        QUIT OUT
ESCAPE(VAL,HL) ;Escape any special characters
 +1       ;
 +2       ;  Input:
 +3       ;    VAL - value to escape
 +4       ;     HL - HL7 environment array
 +5       ;
 +6       ;  Output:
 +7       ;    VAL - passed by reference
 +8       ;
 +9       ;field separator
           NEW FS
 +10      ;component separator
           NEW CS
 +11      ;repetition separator
           NEW RS
 +12      ;escape character
           NEW ES
 +13      ;sub-component separator
           NEW SS
 +14       NEW L,STR,I
 +15      ;
 +16       SET FS=HL("FS")
 +17       SET CS=$EXTRACT(HL("ECH"))
 +18       SET RS=$EXTRACT(HL("ECH"),2)
 +19       SET ES=$EXTRACT(HL("ECH"),3)
 +20       SET SS=$EXTRACT(HL("ECH"),4)
 +21      ;
 +22       IF VAL[ES
               Begin DoDot:1
 +23               SET L=$LENGTH(VAL,ES)
                   SET STR=""
 +24               FOR I=1:1:L
                       SET $PIECE(STR," ",I)=$PIECE(VAL,ES,I)
 +25               SET VAL=STR
               End DoDot:1
 +26       IF VAL[FS
               Begin DoDot:1
 +27               SET L=$LENGTH(VAL,FS)
                   SET STR=""
 +28               FOR I=1:1:L
                       SET $PIECE(STR," ",I)=$PIECE(VAL,FS,I)
 +29               SET VAL=STR
               End DoDot:1
 +30       IF VAL[RS
               Begin DoDot:1
 +31               SET L=$LENGTH(VAL,RS)
                   SET STR=""
 +32               FOR I=1:1:L
                       SET $PIECE(STR," ",I)=$PIECE(VAL,RS,I)
 +33               SET VAL=STR
               End DoDot:1
 +34       IF VAL[CS
               Begin DoDot:1
 +35               SET L=$LENGTH(VAL,CS)
                   SET STR=""
 +36               FOR I=1:1:L
                       SET $PIECE(STR," ",I)=$PIECE(VAL,CS,I)
 +37               SET VAL=STR
               End DoDot:1
 +38       IF VAL[SS
               Begin DoDot:1
 +39               SET L=$LENGTH(VAL,SS)
                   SET STR=""
 +40               FOR I=1:1:L
                       SET $PIECE(STR," ",I)=$PIECE(VAL,SS,I)
 +41               SET VAL=STR
               End DoDot:1
 +42       QUIT VAL