- 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 Mar 13, 2025@21:20:23 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
