Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOERXOU

PSOERXOU.m

Go to the documentation of this file.
  1. PSOERXOU ;ALB/BWF - eRx parsing Utilities ; 12/30/2019 3:46pm
  1. ;;7.0;OUTPATIENT PHARMACY;**581,651**;DEC 1997;Build 30
  1. Q
  1. ;
  1. ; GBL - global root where the data is stored
  1. ; CNT - counter (passed by reference)
  1. ; HF - Header/Footer tag (i.e Name, FormerName, etc.)
  1. ; LN - last name
  1. ; FN - first name
  1. ; MN - middle name
  1. ; SUF - suffix
  1. ; PRE - prefix
  1. ; calling application must build header/footer
  1. 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
  1. I $L(LN)!$L(FN) D
  1. .D C S @GBL@(CNT,0)="<"_HF_">"
  1. .D BL(GBL,.CNT,"LastName",LN),BL(GBL,.CNT,"FirstName",FN),BL(GBL,.CNT,"MiddleName",MN)
  1. .D BL(GBL,.CNT,"Suffix",SUF),BL(GBL,.CNT,"Prefix",PRE)
  1. .D C S @GBL@(CNT,0)="</"_HF_">"
  1. Q
  1. ; GBL - global root where the data is stored
  1. ; CNT - counter (passed by reference)
  1. ; AL1 - address line 1
  1. ; AL2 - address line 2
  1. ; CTY - city
  1. ; ST - State
  1. ; PC - postal code
  1. ; CC - country code
  1. 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.
  1. I $L(AL1)!$L(AL2)!$L(CTY)!$L(ST)!$L(PC)!$L(CC) D
  1. .I $G(ST) S ST=$$GET1^DIQ(5,ST,1,"E")
  1. .D C S @GBL@(CNT,0)="<Address>"
  1. .D BL(GBL,.CNT,"AddressLine1",AL1),BL(GBL,.CNT,"AddressLine2",AL2),BL(GBL,.CNT,"City",CTY)
  1. .D BL(GBL,.CNT,"StateProvince",ST),BL(GBL,.CNT,"PostalCode",PC),BL(GBL,.CNT,"CountryCode",CC)
  1. .D C S @GBL@(CNT,0)="</Address>"
  1. Q
  1. ; GBL - global where outbound XML data is being stored
  1. ; SGBL - source global subscript, ^PS(52.48,IEN,11)
  1. ; CNT - count passed by reference
  1. ; IENS - full ien string up to but not including the communication IEN
  1. ; - this includes top level and subfile level as needed
  1. ; SFILE - subfile number for DIQ call
  1. ; DAFIL - direct address file number
  1. ; DAFLD - direct address field number
  1. ; DAIENS - direct address IEN string
  1. ; build outbound communuication values
  1. OCOMM(GBL,SGBL,CNT,IENS,SFILE,DAFIL,DAFLD,DAIENS) ;
  1. ; do not build if there are no communication numbers
  1. N CSEQ,CIEN,CIENS,TYPE,EMAIL,NUM,EXT,SSMS,DADD,CDAT
  1. ; If no Phone # found, send 0000000000 because it is required
  1. I '$O(@SGBL@("B",0)) D Q
  1. .D C S @GBL@(CNT,0)="<CommunicationNumbers>"
  1. .D C S @GBL@(CNT,0)="<PrimaryTelephone>"
  1. .D C S @GBL@(CNT,0)="<Number>0000000000</Number>"
  1. .D C S @GBL@(CNT,0)="</PrimaryTelephone>"
  1. .D C S @GBL@(CNT,0)="</CommunicationNumbers>"
  1. ;
  1. D C S @GBL@(CNT,0)="<CommunicationNumbers>"
  1. ; loop through and build communication values
  1. S CSEQ=0 F S CSEQ=$O(@SGBL@("B",CSEQ)) Q:'CSEQ D
  1. .S CIEN=$O(@SGBL@("B",CSEQ,0))
  1. .S CIENS=CIEN_","_IENS
  1. .D GETS^DIQ(SFILE,CIENS,"**","IE","CDAT")
  1. .S TYPE=$G(CDAT(SFILE,CIENS,.02,"E"))
  1. .S EMAIL=$G(CDAT(SFILE,CIENS,1,"E")) I EMAIL]"" D BL(GBL,.CNT,"ElectronicMail",EMAIL) Q
  1. .D C S @GBL@(CNT,0)="<"_TYPE_">"
  1. .S NUM=$G(CDAT(SFILE,CIENS,.03,"E")) D BL(GBL,.CNT,"Number",NUM)
  1. .S EXT=$G(CDAT(SFILE,CIENS,.04,"E")) D BL(GBL,.CNT,"Extension",EXT)
  1. .S SSMS=$G(CDAT(SFILE,CIENS,.05,"I")) D BL(GBL,.CNT,"SupportsSMS",SSMS)
  1. .D C S @GBL@(CNT,0)="</"_TYPE_">"
  1. ; get direct address
  1. S DADD=$$GET1^DIQ(DAFIL,DAIENS,DAFLD) D BL(GBL,.CNT,"DirectAddress",DADD)
  1. D C S @GBL@(CNT,0)="</CommunicationNumbers>"
  1. Q
  1. ; sigtype - this is for the Sig types that contian a code, qualifier and text.
  1. ; this type is used so frequently that it has been decided to build a funtion
  1. ; to handle
  1. ; GL - Global location
  1. ; CNT - Counter passed by reference so it can be updated
  1. ; PARENT - this is the parent xml
  1. ; TEXT - the text component value
  1. ; QUAL - the qualifier component value
  1. ; CODE - the code component value
  1. SIGTYPE(GL,CNT,PARENT,TEXT,QUAL,CODE) ;
  1. I $L(TEXT)!($L(QUAL))!($L(CODE)) D
  1. .D C S @GL@(CNT,0)="<"_PARENT_">"
  1. .D BL(.GL,.CNT,"Text",TEXT),BL(.GL,.CNT,"Qualifier",QUAL),BL(.GL,.CNT,"Code",CODE)
  1. .D C S @GL@(CNT,0)="</"_PARENT_">"
  1. Q
  1. ; return institution country code
  1. INSCCODE(PSOSITE) ;
  1. N RELINST,CNTRYIEN,CNTRY
  1. I '$G(PSOSITE) Q ""
  1. S RELINST=$$GET1^DIQ(59,$G(PSOSITE),101,"I") I 'RELINST Q ""
  1. ; fileman read to file 4 supported by IA 10090
  1. S CNTRYIEN=$$GET1^DIQ(4,RELINST,801,"I") I 'CNTRYIEN Q ""
  1. ; fileman read to file 779.004 supported by IA 5768
  1. S CNTRY=$$GET1^DIQ(779.004,CNTRYIEN,1.2,"E")
  1. Q CNTRY
  1. BL(GBL,CNT,TAG,VAR) ;
  1. Q:VAR=""
  1. D C S @GBL@(CNT,0)="<"_TAG_">"_$$SYMENC^MXMLUTL(VAR)_"</"_TAG_">"
  1. Q
  1. C ;
  1. S CNT=$G(CNT)+1
  1. Q