PSOERXOU ;ALB/BWF - eRx parsing Utilities ; 12/30/2019 3:46pm
;;7.0;OUTPATIENT PHARMACY;**581,651**;DEC 1997;Build 30
Q
;
; GBL - global root where the data is stored
; CNT - counter (passed by reference)
; HF - Header/Footer tag (i.e Name, FormerName, etc.)
; LN - last name
; FN - first name
; MN - middle name
; SUF - suffix
; PRE - prefix
; calling application must build header/footer
ONAME(GBL,CNT,HF,LN,FN,MN,SUF,PRE) ;
; conditionally set up name segment. per the XSD, last name and first name are required if there is a name
I $L(LN)!$L(FN) D
.D C S @GBL@(CNT,0)="<"_HF_">"
.D BL(GBL,.CNT,"LastName",LN),BL(GBL,.CNT,"FirstName",FN),BL(GBL,.CNT,"MiddleName",MN)
.D BL(GBL,.CNT,"Suffix",SUF),BL(GBL,.CNT,"Prefix",PRE)
.D C S @GBL@(CNT,0)="</"_HF_">"
Q
; GBL - global root where the data is stored
; CNT - counter (passed by reference)
; AL1 - address line 1
; AL2 - address line 2
; CTY - city
; ST - State
; PC - postal code
; CC - country code
OADD(GBL,CNT,AL1,AL2,CTY,ST,PC,CC) ;
; conditionally create the address segment. there must be data in one of the fields being passed in.
I $L(AL1)!$L(AL2)!$L(CTY)!$L(ST)!$L(PC)!$L(CC) D
.I $G(ST) S ST=$$GET1^DIQ(5,ST,1,"E")
.D C S @GBL@(CNT,0)="<Address>"
.D BL(GBL,.CNT,"AddressLine1",AL1),BL(GBL,.CNT,"AddressLine2",AL2),BL(GBL,.CNT,"City",CTY)
.D BL(GBL,.CNT,"StateProvince",ST),BL(GBL,.CNT,"PostalCode",PC),BL(GBL,.CNT,"CountryCode",CC)
.D C S @GBL@(CNT,0)="</Address>"
Q
; GBL - global where outbound XML data is being stored
; SGBL - source global subscript, ^PS(52.48,IEN,11)
; CNT - count passed by reference
; IENS - full ien string up to but not including the communication IEN
; - this includes top level and subfile level as needed
; SFILE - subfile number for DIQ call
; DAFIL - direct address file number
; DAFLD - direct address field number
; DAIENS - direct address IEN string
; build outbound communuication values
OCOMM(GBL,SGBL,CNT,IENS,SFILE,DAFIL,DAFLD,DAIENS) ;
; do not build if there are no communication numbers
N CSEQ,CIEN,CIENS,TYPE,EMAIL,NUM,EXT,SSMS,DADD,CDAT
; If no Phone # found, send 0000000000 because it is required
I '$O(@SGBL@("B",0)) D Q
.D C S @GBL@(CNT,0)="<CommunicationNumbers>"
.D C S @GBL@(CNT,0)="<PrimaryTelephone>"
.D C S @GBL@(CNT,0)="<Number>0000000000</Number>"
.D C S @GBL@(CNT,0)="</PrimaryTelephone>"
.D C S @GBL@(CNT,0)="</CommunicationNumbers>"
;
D C S @GBL@(CNT,0)="<CommunicationNumbers>"
; loop through and build communication values
S CSEQ=0 F S CSEQ=$O(@SGBL@("B",CSEQ)) Q:'CSEQ D
.S CIEN=$O(@SGBL@("B",CSEQ,0))
.S CIENS=CIEN_","_IENS
.D GETS^DIQ(SFILE,CIENS,"**","IE","CDAT")
.S TYPE=$G(CDAT(SFILE,CIENS,.02,"E"))
.S EMAIL=$G(CDAT(SFILE,CIENS,1,"E")) I EMAIL]"" D BL(GBL,.CNT,"ElectronicMail",EMAIL) Q
.D C S @GBL@(CNT,0)="<"_TYPE_">"
.S NUM=$G(CDAT(SFILE,CIENS,.03,"E")) D BL(GBL,.CNT,"Number",NUM)
.S EXT=$G(CDAT(SFILE,CIENS,.04,"E")) D BL(GBL,.CNT,"Extension",EXT)
.S SSMS=$G(CDAT(SFILE,CIENS,.05,"I")) D BL(GBL,.CNT,"SupportsSMS",SSMS)
.D C S @GBL@(CNT,0)="</"_TYPE_">"
; get direct address
S DADD=$$GET1^DIQ(DAFIL,DAIENS,DAFLD) D BL(GBL,.CNT,"DirectAddress",DADD)
D C S @GBL@(CNT,0)="</CommunicationNumbers>"
Q
; sigtype - this is for the Sig types that contian a code, qualifier and text.
; this type is used so frequently that it has been decided to build a funtion
; to handle
; GL - Global location
; CNT - Counter passed by reference so it can be updated
; PARENT - this is the parent xml
; TEXT - the text component value
; QUAL - the qualifier component value
; CODE - the code component value
SIGTYPE(GL,CNT,PARENT,TEXT,QUAL,CODE) ;
I $L(TEXT)!($L(QUAL))!($L(CODE)) D
.D C S @GL@(CNT,0)="<"_PARENT_">"
.D BL(.GL,.CNT,"Text",TEXT),BL(.GL,.CNT,"Qualifier",QUAL),BL(.GL,.CNT,"Code",CODE)
.D C S @GL@(CNT,0)="</"_PARENT_">"
Q
; return institution country code
INSCCODE(PSOSITE) ;
N RELINST,CNTRYIEN,CNTRY
I '$G(PSOSITE) Q ""
S RELINST=$$GET1^DIQ(59,$G(PSOSITE),101,"I") I 'RELINST Q ""
; fileman read to file 4 supported by IA 10090
S CNTRYIEN=$$GET1^DIQ(4,RELINST,801,"I") I 'CNTRYIEN Q ""
; fileman read to file 779.004 supported by IA 5768
S CNTRY=$$GET1^DIQ(779.004,CNTRYIEN,1.2,"E")
Q CNTRY
BL(GBL,CNT,TAG,VAR) ;
Q:VAR=""
D C S @GBL@(CNT,0)="<"_TAG_">"_$$SYMENC^MXMLUTL(VAR)_"</"_TAG_">"
Q
C ;
S CNT=$G(CNT)+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXOU 4465 printed Dec 13, 2024@02:29 Page 2
PSOERXOU ;ALB/BWF - eRx parsing Utilities ; 12/30/2019 3:46pm
+1 ;;7.0;OUTPATIENT PHARMACY;**581,651**;DEC 1997;Build 30
+2 QUIT
+3 ;
+4 ; GBL - global root where the data is stored
+5 ; CNT - counter (passed by reference)
+6 ; HF - Header/Footer tag (i.e Name, FormerName, etc.)
+7 ; LN - last name
+8 ; FN - first name
+9 ; MN - middle name
+10 ; SUF - suffix
+11 ; PRE - prefix
+12 ; calling application must build header/footer
ONAME(GBL,CNT,HF,LN,FN,MN,SUF,PRE) ;
+1 ; conditionally set up name segment. per the XSD, last name and first name are required if there is a name
+2 IF $LENGTH(LN)!$LENGTH(FN)
Begin DoDot:1
+3 DO C
SET @GBL@(CNT,0)="<"_HF_">"
+4 DO BL(GBL,.CNT,"LastName",LN)
DO BL(GBL,.CNT,"FirstName",FN)
DO BL(GBL,.CNT,"MiddleName",MN)
+5 DO BL(GBL,.CNT,"Suffix",SUF)
DO BL(GBL,.CNT,"Prefix",PRE)
+6 DO C
SET @GBL@(CNT,0)="</"_HF_">"
End DoDot:1
+7 QUIT
+8 ; GBL - global root where the data is stored
+9 ; CNT - counter (passed by reference)
+10 ; AL1 - address line 1
+11 ; AL2 - address line 2
+12 ; CTY - city
+13 ; ST - State
+14 ; PC - postal code
+15 ; CC - country code
OADD(GBL,CNT,AL1,AL2,CTY,ST,PC,CC) ;
+1 ; conditionally create the address segment. there must be data in one of the fields being passed in.
+2 IF $LENGTH(AL1)!$LENGTH(AL2)!$LENGTH(CTY)!$LENGTH(ST)!$LENGTH(PC)!$LENGTH(CC)
Begin DoDot:1
+3 IF $GET(ST)
SET ST=$$GET1^DIQ(5,ST,1,"E")
+4 DO C
SET @GBL@(CNT,0)="<Address>"
+5 DO BL(GBL,.CNT,"AddressLine1",AL1)
DO BL(GBL,.CNT,"AddressLine2",AL2)
DO BL(GBL,.CNT,"City",CTY)
+6 DO BL(GBL,.CNT,"StateProvince",ST)
DO BL(GBL,.CNT,"PostalCode",PC)
DO BL(GBL,.CNT,"CountryCode",CC)
+7 DO C
SET @GBL@(CNT,0)="</Address>"
End DoDot:1
+8 QUIT
+9 ; GBL - global where outbound XML data is being stored
+10 ; SGBL - source global subscript, ^PS(52.48,IEN,11)
+11 ; CNT - count passed by reference
+12 ; IENS - full ien string up to but not including the communication IEN
+13 ; - this includes top level and subfile level as needed
+14 ; SFILE - subfile number for DIQ call
+15 ; DAFIL - direct address file number
+16 ; DAFLD - direct address field number
+17 ; DAIENS - direct address IEN string
+18 ; build outbound communuication values
OCOMM(GBL,SGBL,CNT,IENS,SFILE,DAFIL,DAFLD,DAIENS) ;
+1 ; do not build if there are no communication numbers
+2 NEW CSEQ,CIEN,CIENS,TYPE,EMAIL,NUM,EXT,SSMS,DADD,CDAT
+3 ; If no Phone # found, send 0000000000 because it is required
+4 IF '$ORDER(@SGBL@("B",0))
Begin DoDot:1
+5 DO C
SET @GBL@(CNT,0)="<CommunicationNumbers>"
+6 DO C
SET @GBL@(CNT,0)="<PrimaryTelephone>"
+7 DO C
SET @GBL@(CNT,0)="<Number>0000000000</Number>"
+8 DO C
SET @GBL@(CNT,0)="</PrimaryTelephone>"
+9 DO C
SET @GBL@(CNT,0)="</CommunicationNumbers>"
End DoDot:1
QUIT
+10 ;
+11 DO C
SET @GBL@(CNT,0)="<CommunicationNumbers>"
+12 ; loop through and build communication values
+13 SET CSEQ=0
FOR
SET CSEQ=$ORDER(@SGBL@("B",CSEQ))
if 'CSEQ
QUIT
Begin DoDot:1
+14 SET CIEN=$ORDER(@SGBL@("B",CSEQ,0))
+15 SET CIENS=CIEN_","_IENS
+16 DO GETS^DIQ(SFILE,CIENS,"**","IE","CDAT")
+17 SET TYPE=$GET(CDAT(SFILE,CIENS,.02,"E"))
+18 SET EMAIL=$GET(CDAT(SFILE,CIENS,1,"E"))
IF EMAIL]""
DO BL(GBL,.CNT,"ElectronicMail",EMAIL)
QUIT
+19 DO C
SET @GBL@(CNT,0)="<"_TYPE_">"
+20 SET NUM=$GET(CDAT(SFILE,CIENS,.03,"E"))
DO BL(GBL,.CNT,"Number",NUM)
+21 SET EXT=$GET(CDAT(SFILE,CIENS,.04,"E"))
DO BL(GBL,.CNT,"Extension",EXT)
+22 SET SSMS=$GET(CDAT(SFILE,CIENS,.05,"I"))
DO BL(GBL,.CNT,"SupportsSMS",SSMS)
+23 DO C
SET @GBL@(CNT,0)="</"_TYPE_">"
End DoDot:1
+24 ; get direct address
+25 SET DADD=$$GET1^DIQ(DAFIL,DAIENS,DAFLD)
DO BL(GBL,.CNT,"DirectAddress",DADD)
+26 DO C
SET @GBL@(CNT,0)="</CommunicationNumbers>"
+27 QUIT
+28 ; sigtype - this is for the Sig types that contian a code, qualifier and text.
+29 ; this type is used so frequently that it has been decided to build a funtion
+30 ; to handle
+31 ; GL - Global location
+32 ; CNT - Counter passed by reference so it can be updated
+33 ; PARENT - this is the parent xml
+34 ; TEXT - the text component value
+35 ; QUAL - the qualifier component value
+36 ; CODE - the code component value
SIGTYPE(GL,CNT,PARENT,TEXT,QUAL,CODE) ;
+1 IF $LENGTH(TEXT)!($LENGTH(QUAL))!($LENGTH(CODE))
Begin DoDot:1
+2 DO C
SET @GL@(CNT,0)="<"_PARENT_">"
+3 DO BL(.GL,.CNT,"Text",TEXT)
DO BL(.GL,.CNT,"Qualifier",QUAL)
DO BL(.GL,.CNT,"Code",CODE)
+4 DO C
SET @GL@(CNT,0)="</"_PARENT_">"
End DoDot:1
+5 QUIT
+6 ; return institution country code
INSCCODE(PSOSITE) ;
+1 NEW RELINST,CNTRYIEN,CNTRY
+2 IF '$GET(PSOSITE)
QUIT ""
+3 SET RELINST=$$GET1^DIQ(59,$GET(PSOSITE),101,"I")
IF 'RELINST
QUIT ""
+4 ; fileman read to file 4 supported by IA 10090
+5 SET CNTRYIEN=$$GET1^DIQ(4,RELINST,801,"I")
IF 'CNTRYIEN
QUIT ""
+6 ; fileman read to file 779.004 supported by IA 5768
+7 SET CNTRY=$$GET1^DIQ(779.004,CNTRYIEN,1.2,"E")
+8 QUIT CNTRY
BL(GBL,CNT,TAG,VAR) ;
+1 if VAR=""
QUIT
+2 DO C
SET @GBL@(CNT,0)="<"_TAG_">"_$$SYMENC^MXMLUTL(VAR)_"</"_TAG_">"
+3 QUIT
C ;
+1 SET CNT=$GET(CNT)+1
+2 QUIT
