- 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 Feb 18, 2025@23:55:26 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