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

PSOERXX2.m

Go to the documentation of this file. 
  1. PSOERXX2 ;ALB/BWF - eRx xml utilities ; 8/3/2016 5:14pm
  1.  ;;7.0;OUTPATIENT PHARMACY;**467,508,581**;DEC 1997;Build 126
  1.  ;
  1.  Q
  1. MSG(GBL,HF) ;
  1.  Q:'HF
  1.  I HF=1 D C S @GBL@(CNT,0)="<?xml version=""1.0"" encoding=""UTF-8""?><Message version=""010"" release=""006"" HighestVersionSupported="""" xmlns=""http://www.ncpdp.org/schema/SCRIPT"">" Q
  1.  I HF=2 D C S @GBL@(CNT,0)="</Message>"
  1.  Q
  1. HDR(GBL,IEN) ;
  1.  N F,TOQUAL,TOVAL,FRQUAL,FRVAL,MID,STIME,STERTID,RTERTID,PON,RETREC,REQREF,PSDAT,INST,SSECID,RSECID,ERXHID
  1.  N RTMID
  1.  S F=52.49
  1.  S IENS=IEN_","
  1.  D GETS^DIQ(F,IENS,"**","IE","PSDAT")
  1.  D CONVXML^PSOERXX1("PSDAT")
  1.  S ERXHID=$G(PSDAT(F,IENS,.01,"E"))
  1.  ; 'TO' values come from the 'FROM' fields of the eRx.
  1.  S TOQUAL=$G(PSDAT(F,IENS,22.2,"I"))
  1.  S TOVAL=$G(PSDAT(F,IENS,22.1,"E"))
  1.  ; 'FROM' values come from the 'TO' fields of the eRx.
  1.  S FRQUAL=$G(PSDAT(F,IENS,22.4,"I"))
  1.  S FRVAL=$G(PSDAT(F,IENS,22.3,"E"))
  1.  S INST=DUZ(2)
  1.  ; message ID needs to be unique from vista - Site#.erxIEN.date.time
  1.  S MID=INST_"."_PSOIEN_"."_$$NOW^XLFDT
  1.  S RTMID=$G(PSDAT(F,IENS,25,"E"))
  1.  ;
  1.  S PON=$G(PSDAT(F,IENS,.09,"E"))
  1.  ; return receipt and request reference # currenly not stored. Do we need to add a field in 52.49?
  1.  S RETREC=$G(PSDAT(F,IENS,1,"E"))
  1.  S REQREF=$G(PSDAT(F,IENS,1,"E"))
  1.  S RETREC="ACA",REQREF=""
  1.  S SSECID=$G(PSDAT(F,IENS,24.5,"E"))
  1.  ; leaving this in place for now CH wanted the tertiary ID to be TECHNATOMY. I suspect this will
  1.  ; need to be something different in the long run
  1.  S STERTID="TECHNATOMY"
  1.  S RSECID=$G(PSDAT(F,IENS,24.3,"E"))
  1.  S RTERTID="ERXPAD"
  1.  D C S @GBL@(CNT,0)="<Header><To Qualifier="""_TOQUAL_""">"_TOVAL_"</To>"
  1.  D C S @GBL@(CNT,0)="<From Qualifier="""_FRQUAL_""">"_FRVAL_"</From>"
  1.  D C S @GBL@(CNT,0)="<MessageID>"_MID_"</MessageID>"
  1.  ; relatesToMessageID is the CH messageID - FIELD 25
  1.  I $L(RTMID) D C S @GBL@(CNT,0)="<RelatesToMessageID>"_RTMID_"</RelatesToMessageID>"
  1.  D C S @GBL@(CNT,0)="<SentTime>"_$$EXTIME^PSOERXO1()_"</SentTime>"
  1.  D C S @GBL@(CNT,0)="<Security>"
  1.  D C S @GBL@(CNT,0)="<Sender>"
  1.  ; for now we are not using secondary identifications, this will stay in place for future activation.
  1.  ;I $L(SSECID) D C S @GBL@(CNT,0)="<SecondaryIdentification>"_SSECID_"</SecondaryIdentification>"
  1.  I $L(STERTID) D C S @GBL@(CNT,0)="<TertiaryIdentification>"_STERTID_"</TertiaryIdentification>"
  1.  D C S @GBL@(CNT,0)="</Sender>"
  1.  D C S @GBL@(CNT,0)="<Receiver>"
  1.  ;I $L(RSECID) D C S @GBL@(CNT,0)="<SecondaryIdentification>"_RSECID_"</SecondaryIdentification>"
  1.  I $L(RTERTID) D C S @GBL@(CNT,0)="<TertiaryIdentification>"_RTERTID_"</TertiaryIdentification>"
  1.  D C S @GBL@(CNT,0)="</Receiver>"
  1.  D C S @GBL@(CNT,0)="</Security>"
  1.  ; missing 'Mailbox' - note for future enhancement. Was not needed for CH certification.
  1.  D C S @GBL@(CNT,0)="<RxReferenceNumber>"_ERXHID_"</RxReferenceNumber>"
  1.  I $L(PON) D C S @GBL@(CNT,0)="<PrescriberOrderNumber>"_PON_"</PrescriberOrderNumber>"
  1.  D C S @GBL@(CNT,0)="</Header>"
  1.  Q MID
  1.  ; body header/footer
  1. BHF(GBL,HF) ;
  1.  Q:'$D(HF)
  1.  D C
  1.  S @GBL@(CNT,0)=$S(HF=1:"<Body>",HF=2:"</Body>",1:"")
  1.  Q
  1.  ;HF   1 - header
  1.  ;     2 - footer
  1. RTYPE(GBL,RTYPE,HF) ;
  1.  Q:'HF
  1.  D C
  1.  S @GBL@(CNT,0)=$S(HF=1:"<"_RTYPE_">",HF=2:"</"_RTYPE_">",1:"")
  1.  Q
  1. REQUEST(GBL,RETREC,REQREF) ;
  1.  D C S @GBL@(CNT,0)="<Request>"
  1.  D C S @GBL@(CNT,0)="<ReturnReceipt>"_RETREC_"</ReturnReceipt>"
  1.  D C S @GBL@(CNT,0)="<RequestReferenceNumber>"_REQREF_"</RequestReferenceNumber>"
  1.  D C S @GBL@(CNT,0)="</Request>"
  1.  Q
  1. VAPHARM(GBL,PSOSITE,PSOIEN) ;
  1.  N F,F2,NCPID,NPI,SPEC,LNAME,FNAME,MNAME,SUFF,PREF,STNM,ADDL1,ADDL2,CITY,STATE,PLQ,TELE,UIENS
  1.  N PHIEN,PHIENS,EXPHIEN,EXPHIENS,PHARDAT,PHARDAT,PSDAT,AREA,FTELE,FULLNM,PDAT,PHRMCIST,SIENS
  1.  N EIEN,EIENS,CMNUM,ID,IDTYP,IDVAL,CMVAL,CMQUAL
  1.  S F=52.47,F2=52.48
  1.  ; this is the vista pharmacy/pharmacist
  1.  S EIEN=$$GET1^DIQ(52.49,PSOIEN,2.5,"I")
  1.  S EIENS=EIEN_","
  1.  S PHIEN=$$GET1^DIQ(52.49,PSOIEN,2.2,"I")
  1.  S PHIENS=PHIEN_","
  1.  D GETS^DIQ(F,EIENS,"**","IE","PHARDAT")
  1.  S NCPID=$G(PHARDAT(F,EIENS,.02,"E"))
  1.  D GETS^DIQ(F2,PHIENS,"**","IE","PHRMCIST")
  1.  D CONVXML^PSOERXX1("PHARDAT"),CONVXML^PSOERXX1("PHRMCIST")
  1.  ;S FULLNM=$G(PHRMCIST(F2,UIENS,.01,"E"))
  1.  S LNAME=$G(PHRMCIST(F2,PHIENS,.02,"E"))
  1.  S FNAME=$G(PHRMCIST(F2,PHIENS,.03,"E"))
  1.  S MNAME=$G(PHRMCIST(F2,PHIENS,.04,"E"))
  1.  S SUFF=$G(PHRMCIST(F2,PHIENS,.05,"E"))
  1.  S PREF=$G(PHRMCIST(F2,PHIENS,.06,"E"))
  1.  S NPI=$G(PHRMCIST(F2,PHIENS,1.5,"E"))
  1.  S STNM=$G(PHARDAT(F,EIENS,.01,"E"))
  1.  S ADDL1=$G(PHARDAT(F,EIENS,1.1,"E"))
  1.  S ADDL2=$G(PHARDAT(F,EIENS,1.2,"E"))
  1.  S CITY=$G(PHARDAT(F,EIENS,1.3,"E"))
  1.  S STATE=$G(PHARDAT(F,EIENS,1.4,"I"))
  1.  S STATE=$$STRES(STATE,PSOSITE)
  1.  S ZIP=$G(PHARDAT(F,EIENS,1.5,"E")),ZIP=$TR(ZIP,"-","")
  1.  ; address missing from NewRx
  1.  I '$L(ADDL1) D
  1.  .S ADDL1=$$GET1^DIQ(59,PSOSITE,.02,"E")
  1.  .S ADDL2=""
  1.  .S CITY=$$GET1^DIQ(59,PSOSITE,.07,"E")
  1.  .S STATE=$$GET1^DIQ(59,PSOSITE,.08,"I")
  1.  .I STATE S STATE=$$GET1^DIQ(5,STATE,1,"E")
  1.  .S ZIP=$E($$GET1^DIQ(59,PSOSITE,.05,"E"),1,5)
  1.  D C S @GBL@(CNT,0)="<Pharmacy>"
  1.  I $O(^PS(52.47,EIEN,2,0)) D
  1.  .D C S @GBL@(CNT,0)="<Identification>"
  1.  .S ID=0 F  S ID=$O(^PS(52.47,EIEN,2,ID)) Q:'ID  D
  1.  ..S IDTYP=$$GET1^DIQ(52.472,ID_","_EIEN_",",.01,"E")
  1.  ..S IDVAL=$$GET1^DIQ(52.472,ID_","_EIEN_",",.02,"E")
  1.  ..F VAR="IDTYP","IDVAL" S @VAR=$$SYMENC^MXMLUTL(@VAR)
  1.  ..D C S @GBL@(CNT,0)="<"_IDTYP_">"_IDVAL_"</"_IDTYP_">"
  1.  .D C S @GBL@(CNT,0)="</Identification>"
  1.  ;D C S @GBL@(CNT,0)="<Specialty>"_SPEC_"</Specialty>"
  1.  I $L(LNAME) D
  1.  .D C S @GBL@(CNT,0)="<Pharmacist>"
  1.  .I $L(LNAME) D C S @GBL@(CNT,0)="<LastName>"_LNAME_"</LastName>"
  1.  .I $L(FNAME) D C S @GBL@(CNT,0)="<FirstName>"_FNAME_"</FirstName>"
  1.  .I $L(MNAME) D C S @GBL@(CNT,0)="<MiddleName>"_MNAME_"</MiddleName>"
  1.  .I $L(SUFF) D C S @GBL@(CNT,0)="<Suffix>"_SUFF_"</Suffix>"
  1.  .I $L(PREF) D C S @GBL@(CNT,0)="<Prefix>"_PREF_"</Prefix>"
  1.  .D C S @GBL@(CNT,0)="</Pharmacist>"
  1.  I $L(STNM) D C S @GBL@(CNT,0)="<StoreName>"_STNM_"</StoreName>"
  1.  I $L(ADDL1)!($L(ADDL2))!($L(CITY))!($L(STATE))!($L(ZIP)) D
  1.  .D C S @GBL@(CNT,0)="<Address>"
  1.  .I $L(ADDL1) D C S @GBL@(CNT,0)="<AddressLine1>"_ADDL1_"</AddressLine1>"
  1.  .I $L(ADDL2) D C S @GBL@(CNT,0)="<AddressLine2>"_ADDL2_"</AddressLine2>"
  1.  .I $L(CITY) D C S @GBL@(CNT,0)="<City>"_CITY_"</City>"
  1.  .I $L(STATE) D C S @GBL@(CNT,0)="<State>"_STATE_"</State>"
  1.  .I $L(ZIP) D C S @GBL@(CNT,0)="<ZipCode>"_ZIP_"</ZipCode>"
  1.  .;D C S @GBL@(CNT,0)="<PlaceLocationQualifier>"_PLQ_"</PlaceLocationQualifier>"
  1.  .D C S @GBL@(CNT,0)="</Address>"
  1.  I '$O(^PS(52.47,EIEN,3,0)) D
  1.  .S CMVAL=$$GET1^DIQ(59,PSOIEN,.03,"E")
  1.  .S CMVAL=CMVAL_$$GET1^DIQ(59,PSOIEN,.04,"E")
  1.  .I '$L(CMVAL) S CMVAL="0000000000"
  1.  .S CMVAL=$TR(CMVAL,"-","")
  1.  .S CMQUAL="TE"
  1.  .D C S @GBL@(CNT,0)="<CommunicationNumbers>"
  1.  .D COMMNUM(.GBL,CMVAL,CMQUAL)
  1.  .D COMMNUM(.GBL,"0000000000","FX")
  1.  .D C S @GBL@(CNT,0)="</CommunicationNumbers>"
  1.  I $O(^PS(52.47,EIEN,3,0)) D
  1.  .D C S @GBL@(CNT,0)="<CommunicationNumbers>"
  1.  .S CMNUM=0 F  S CMNUM=$O(^PS(52.47,EIEN,3,CMNUM)) Q:'CMNUM  D
  1.  ..S CMVAL=$$GET1^DIQ(52.473,CMNUM_","_EIEN_",",.01,"E")
  1.  ..S CMQUAL=$$GET1^DIQ(52.473,CMNUM_","_EIEN_",",.02,"I")
  1.  ..D COMMNUM(.GBL,CMVAL,CMQUAL)
  1.  .D C S @GBL@(CNT,0)="</CommunicationNumbers>"
  1.  D C S @GBL@(CNT,0)="</Pharmacy>"
  1.  Q
  1.  ; GBL - global for xml storage
  1.  ; IENS - ien string for the current entry
  1.  ; FIL - top level file number
  1.  ; SUBFIL - subfile number
  1. COMMNUM(GBL,COMMNUM,QUAL) ;
  1.  D C S @GBL@(CNT,0)="<Communication>"
  1.  D C S @GBL@(CNT,0)="<Number>"_$$SYMENC^MXMLUTL(COMMNUM)_"</Number>"
  1.  D C S @GBL@(CNT,0)="<Qualifier>"_$$SYMENC^MXMLUTL(QUAL)_"</Qualifier>"
  1.  D C S @GBL@(CNT,0)="</Communication>"
  1.  Q
  1. IDENT(GBL,TYPE,VAL) ;
  1.  N VAR
  1.  F VAR="TYPE","VAL" S @VAR=$$SYMENC^MXMLUTL(@VAR)
  1.  D C S @GBL@(CNT,0)="<"_TYPE_">"_VAL_"</"_TYPE_">"
  1.  Q
  1.  ; GBL - GLOBAL WHERE DATA IS STORED
  1.  ; IEN - IEN TO 52.49
  1. PRESCRIB(GBL,PSOSITE,IEN) ;
  1.  N F,DEAN,NPI,SPEC,CLINIC,LNAME,FNAME,MNAME,SUFF,PREF,ADDL1,ADDL2,CITY,STATE,ZIP,PLQ,ALNAME,AFNAME,AMNAME,ASUFF,APREF
  1.  N PSDAT,CLOOP,CNUM,CQUAL,ILOOP,ITYP,IVAL,PIEN,PIENS
  1.  S F=52.48,IENS=IEN_","
  1.  S PIEN=$$GET1^DIQ(52.49,IEN,2.1,"I") Q:'PIEN
  1.  S PIENS=PIEN_","
  1.  D GETS^DIQ(F,PIENS,"**","IE","PSDAT")
  1.  D CONVXML^PSOERXX1("PSDAT")
  1.  S DEAN=$G(PSDAT(F,PIENS,1.6,"E"))
  1.  S NPI=$G(PSDAT(F,PIENS,1.5,"E"))
  1.  S SPEC=$G(PSDAT(F,PIENS,1.2,"E"))
  1.  S CLINIC=$G(PSDAT(F,PIENS,2.1,"E"))
  1.  S LNAME=$G(PSDAT(F,PIENS,.02,"E"))
  1.  S FNAME=$G(PSDAT(F,PIENS,.03,"E"))
  1.  S MNAME=$G(PSDAT(F,PIENS,.04,"E"))
  1.  S SUFF=$G(PSDAT(F,PIENS,.05,"E"))
  1.  S PREF=$G(PSDAT(F,PIENS,.06,"E"))
  1.  S ADDL1=$G(PSDAT(F,PIENS,4.1,"E"))
  1.  S ADDL2=$G(PSDAT(F,PIENS,4.2,"E"))
  1.  S CITY=$G(PSDAT(F,PIENS,4.3,"E"))
  1.  S STATE=$G(PSDAT(F,PIENS,4.4,"I"))
  1.  S STATE=$$STRES(STATE,PSOSITE)
  1.  S ZIP=$G(PSDAT(F,PIENS,4.5,"E"))
  1.  S PLQ=$G(PSDAT(F,PIENS,2.2,"E"))
  1.  S ALNAME=$G(PSDAT(F,PIENS,5.1,"E"))
  1.  S AFNAME=$G(PSDAT(F,PIENS,5.2,"E"))
  1.  S AMNAME=$G(PSDAT(F,PIENS,5.3,"E"))
  1.  S ASUFF=$G(PSDAT(F,PIENS,5.4,"E"))
  1.  S APREF=$G(PSDAT(F,PIENS,5.5,"E"))
  1.  D C S @GBL@(CNT,0)="<Prescriber>"
  1.  I $O(^PS(52.48,PIEN,6,0)) D
  1.  .D C S @GBL@(CNT,0)="<Identification>"
  1.  .S ILOOP=0 F  S ILOOP=$O(^PS(52.48,PIEN,6,ILOOP)) Q:'ILOOP  D
  1.  ..S ITYP=$$GET1^DIQ(52.486,ILOOP_","_PIENS,.01,"E")
  1.  ..S IVAL=$$GET1^DIQ(52.486,ILOOP_","_PIENS,.02,"E")
  1.  ..D IDENT(.GBL,ITYP,IVAL)
  1.  .D C S @GBL@(CNT,0)="</Identification>"
  1.  I $L(SPEC) D C S @GBL@(CNT,0)="<Specialty>"_SPEC_"</Specialty>" ; ***SLASH AT THE END???
  1.  I $L(CLINIC) D C S @GBL@(CNT,0)="<ClinicName>"_CLINIC_"</ClinicName>" ; ***SLASH AT THE END???
  1.  D C S @GBL@(CNT,0)="<Name>"
  1.  I $L(LNAME) D C S @GBL@(CNT,0)="<LastName>"_LNAME_"</LastName>"
  1.  I $L(FNAME) D C S @GBL@(CNT,0)="<FirstName>"_FNAME_"</FirstName>"
  1.  I $L(MNAME) D C S @GBL@(CNT,0)="<MiddleName>"_MNAME_"</MiddleName>"
  1.  I $L(SUFF) D C S @GBL@(CNT,0)="<Suffix>"_SUFF_"</Suffix>"
  1.  I $L(PREF) D C S @GBL@(CNT,0)="<Prefix>"_PREF_"</Prefix>"
  1.  D C S @GBL@(CNT,0)="</Name>"
  1.  D C S @GBL@(CNT,0)="<Address>"
  1.  I $L(ADDL1) D C S @GBL@(CNT,0)="<AddressLine1>"_ADDL1_"</AddressLine1>"
  1.  I $L(ADDL2) D C S @GBL@(CNT,0)="<AddressLine2>"_ADDL2_"</AddressLine2>"
  1.  I $L(CITY) D C S @GBL@(CNT,0)="<City>"_CITY_"</City>"
  1.  I $L(STATE) D C S @GBL@(CNT,0)="<State>"_STATE_"</State>"
  1.  I $L(ZIP) D C S @GBL@(CNT,0)="<ZipCode>"_ZIP_"</ZipCode>"
  1.  I $L(PLQ) D C S @GBL@(CNT,0)="<PlaceLocationQualifier>"_PLQ_"</PlaceLocationQualifier>"
  1.  D C S @GBL@(CNT,0)="</Address>"
  1.  I $O(^PS(52.48,PIEN,3,0)) D
  1.  .D C S @GBL@(CNT,0)="<CommunicationNumbers>"
  1.  .S CLOOP=0 F  S CLOOP=$O(^PS(52.48,PIEN,3,CLOOP)) Q:'CLOOP  D
  1.  ..S CNUM=$$GET1^DIQ(52.483,CLOOP_","_PIENS,.01,"E")
  1.  ..S CQUAL=$$GET1^DIQ(52.483,CLOOP_","_PIENS,.02,"I")
  1.  ..D COMMNUM(.GBL,CNUM,CQUAL)
  1.  .D C S @GBL@(CNT,0)="</CommunicationNumbers>"
  1.  I $L(ALNAME) D
  1.  .D C S @GBL@(CNT,0)="<PrescriberAgent>"
  1.  .I $L(ALNAME) D C S @GBL@(CNT,0)="<LastName>"_ALNAME_"</LastName>"
  1.  .I $L(AFNAME) D C S @GBL@(CNT,0)="<FirstName>"_AFNAME_"</FirstName>"
  1.  .I $L(AMNAME) D C S @GBL@(CNT,0)="<MiddleName>"_AMNAME_"</MiddleName>"
  1.  .I $L(ASUFF) D C S @GBL@(CNT,0)="<Suffix>"_ASUFF_"</Suffix>"
  1.  .I $L(APREF) D C S @GBL@(CNT,0)="<Prefix>"_APREF_"</Prefix>"
  1.  .D C S @GBL@(CNT,0)="</PrescriberAgent>"
  1.  D C S @GBL@(CNT,0)="</Prescriber>"
  1.  Q
  1. SUPERVIS(GBL,PSOSITE,IEN) ;
  1.  N F,SLN,DEAN,SPEC,LNAME,FNAME,MNAME,SUFF,PREF,CLNAME,ADDL1,ADDL2,CITY,STATE,ZIP,PLQ,PSDAT,ILOOP,ITYP,IVAL
  1.  N SIEN,SIENS
  1.  S F=52.48
  1.  S IENS=IEN_","
  1.  S SIEN=$$GET1^DIQ(52.49,IEN,2.6,"I") Q:'SIEN
  1.  S SIENS=SIEN_","
  1.  D GETS^DIQ(F,SIENS,"**","IE","PSDAT")
  1.  D CONVXML^PSOERXX1("PSDAT")
  1.  S SLN=$G(PSDAT(F,SIENS,1.8,"E"))
  1.  S DEAN=$G(PSDAT(F,SIENS,1.6,"E"))
  1.  S SPEC=$G(PSDAT(F,SIENS,1.2,"E"))
  1.  S LNAME=$G(PSDAT(F,SIENS,.02,"E"))
  1.  S FNAME=$G(PSDAT(F,SIENS,.03,"E"))
  1.  S MNAME=$G(PSDAT(F,SIENS,.04,"E"))
  1.  S SUFF=$G(PSDAT(F,SIENS,.05,"E"))
  1.  S PREF=$G(PSDAT(F,SIENS,.06,"E"))
  1.  S CLNAME=$G(PSDAT(F,SIENS,2.1,"E"))
  1.  S ADDL1=$G(PSDAT(F,SIENS,4.1,"E"))
  1.  S ADDL2=$G(PSDAT(F,SIENS,4.2,"E"))
  1.  S CITY=$G(PSDAT(F,SIENS,4.3,"E"))
  1.  S STATE=$G(PSDAT(F,SIENS,4.4,"I"))
  1.  S STATE=$$STRES(STATE)
  1.  S ZIP=$G(PSDAT(F,SIENS,4.5,"E"))
  1.  S PLQ=$G(PSDAT(F,SIENS,2.2,"E"))
  1.  D C S @GBL@(CNT,0)="<Supervisor>"
  1.  I $O(^PS(52.48,SIEN,6,0)) D
  1.  .D C S @GBL@(CNT,0)="<Identification>"
  1.  .S ILOOP=0 F  S ILOOP=$O(^PS(52.48,SIEN,6,ILOOP)) Q:'ILOOP  D
  1.  ..S ITYP=$$GET1^DIQ(52.486,ILOOP_","_SIENS,.01,"E")
  1.  ..S IVAL=$$GET1^DIQ(52.486,ILOOP_","_SIENS,.02,"E")
  1.  ..D IDENT(.GBL,ITYP,IVAL)
  1.  .D C S @GBL@(CNT,0)="</Identification>"
  1.  D C S @GBL@(CNT,0)="<Specialty>"_SPEC_"</Specialty>"
  1.  D C S @GBL@(CNT,0)="<Name>"
  1.  D C S @GBL@(CNT,0)="<LastName>"_LNAME_"</LastName>"
  1.  D C S @GBL@(CNT,0)="<FirstName>"_FNAME_"</FirstName>"
  1.  D C S @GBL@(CNT,0)="<MiddleName>"_MNAME_"</MiddleName>"
  1.  D C S @GBL@(CNT,0)="<Suffix>"_SUFF_"</Suffix>"
  1.  D C S @GBL@(CNT,0)="<Prefix>"_PREF_"</Prefix>"
  1.  D C S @GBL@(CNT,0)="</Name>"
  1.  D C S @GBL@(CNT,0)="<ClinicName>"_CLNAME_"</ClinicName>"
  1.  D C S @GBL@(CNT,0)="<Address>"
  1.  D C S @GBL@(CNT,0)="<AddressLine1>"_ADDL1_"</AddressLine1>"
  1.  D C S @GBL@(CNT,0)="<AddressLine2>"_ADDL2_"</AddressLine2>"
  1.  D C S @GBL@(CNT,0)="<City>"_CITY_"</City>"
  1.  D C S @GBL@(CNT,0)="<State>"_STATE_"</State>"
  1.  I $L(ZIP) D C S @GBL@(CNT,0)="<ZipCode>"_ZIP_"</ZipCode>"
  1.  D C S @GBL@(CNT,0)="<PlaceLocationQualifier>"_PLQ_"</PlaceLocationQualifier>"
  1.  D C S @GBL@(CNT,0)="</Address>"
  1.  D C S @GBL@(CNT,0)="<CommunicationNumbers>"
  1.  S CLOOP=0 F  S CLOOP=$O(^PS(52.48,SIEN,3,CLOOP)) Q:'CLOOP  D
  1.  .S CNUM=$$GET1^DIQ(52.483,CLOOP_","_SIENS,.01,"E")
  1.  .S CQUAL=$$GET1^DIQ(52.483,CLOOP_","_SIENS,.02,"I")
  1.  .D COMMNUM(.GBL,CNUM,CQUAL)
  1.  ; ***COMMUNICATION NUMBERS***
  1.  D C S @GBL@(CNT,0)="</CommunicationNumbers>"
  1.  D C S @GBL@(CNT,0)="</Supervisor>"
  1.  Q
  1. FACIL(GBL,PSOSITE,IENS) ;
  1.  N F,NPI,NAME,ADDL1,ADDL2,CITY,STATE,ZIP,PLQ,PSDAT
  1.  S F=52.49
  1.  ; FOR NOW, JUST BUILD HEADER AND FOOTER
  1.  Q
  1.  D C S @GBL@(CNT,0)="<Facility>"
  1.  D C S @GBL@(CNT,0)="</Facility>"
  1.  Q
  1.  ; complete this as a future enhancement
  1.  D GETS^DIQ(F,IENS,"**","IE","PSDAT")
  1.  D CONVXML^PSOERXX1("PSDAT")
  1.  S NPI=$G(PSDAT(F,IENS,1,"E"))
  1.  S NAME=$G(PSDAT(F,IENS,1,"E"))
  1.  S ADDL1=$G(PSDAT(F,IENS,1,"E"))
  1.  S ADDL2=$G(PSDAT(F,IENS,1,"E"))
  1.  S CITY=$G(PSDAT(F,IENS,1,"E"))
  1.  S STATE=$G(PSDAT(F,IENS,1,"I"))
  1.  S STATE=$$STRES(STATE)
  1.  S ZIP=$G(PSDAT(F,IENS,1,"E"))
  1.  S PLQ=$G(PSDAT(F,IENS,1,"E"))
  1.  D C S @GBL@(CNT,0)="<Facility>"
  1.  I $L(NPI) D
  1.  .D C S @GBL@(CNT,0)="<Identification>"
  1.  .D C S @GBL@(CNT,0)="<NPI>"_NPI_"<NPI>"
  1.  .D C S @GBL@(CNT,0)="</Identification>"
  1.  D C S @GBL@(CNT,0)="<FacilityName>"_NAME_"</FacilityName>"
  1.  D C S @GBL@(CNT,0)="<Address>"
  1.  D C S @GBL@(CNT,0)="<AddressLine1>"_ADDL1_"</AddressLine1>"
  1.  D C S @GBL@(CNT,0)="<AddressLine2>"_ADDL2_"</AddressLine2>"
  1.  D C S @GBL@(CNT,0)="<City>"_CITY_"</City>"
  1.  D C S @GBL@(CNT,0)="<State>"_STATE_"</State>"
  1.  I $L(ZIP) D C S @GBL@(CNT,0)="<ZipCode>"_ZIP_"</ZipCode>"
  1.  D C S @GBL@(CNT,0)="<PlaceLocationQualifier>"_PLQ_"</PlaceLocationQualifier>"
  1.  D C S @GBL@(CNT,0)="</Address>"
  1.  ;***COMMUNICATION NUMBERS
  1.  D C S @GBL@(CNT,0)="</Facility>"
  1.  Q
  1. C ;
  1.  S CNT=$G(CNT)+1
  1.  Q
  1. STRES(STATE,PSOSITE) ;
  1.  N SIEN
  1.  S SIEN=""
  1.  I STATE S SIEN=$$GET1^DIQ(5,STATE,1,"E") Q SIEN
  1.  ; if the state cannot be resolved, use the state from file 59
  1.  I 'SIEN S SIEN=$$GET1^DIQ(59,PSOSITE,.08,"I")
  1.  ; if there is still no state, use the state from the physical address of the institution: IA 2171
  1.  I 'SIEN S SIEN=$P($$PADD^XUAF4(DUZ(2)),U,3)
  1.  Q SIEN