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

PSOERXIU.m

Go to the documentation of this file.
  1. PSOERXIU ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
  1. ;;7.0;OUTPATIENT PHARMACY;**581,635**;DEC 1997;Build 19
  1. ;
  1. Q
  1. NAME(GL) ; returns delimited string - last name^first name^middle name^suffix^prefix
  1. N LNAME,FNAME,MNAME,SUFFIX,PREFIX,RES
  1. S LNAME=$$UP^XLFSTR($G(@GL@("LastName",0)))
  1. S FNAME=$$UP^XLFSTR($G(@GL@("FirstName",0)))
  1. S MNAME=$$UP^XLFSTR($G(@GL@("MiddleName",0)))
  1. S SUFFIX=$$UP^XLFSTR($G(@GL@("Suffix",0)))
  1. S PREFIX=$$UP^XLFSTR($G(@GL@("Prefix",0)))
  1. S RES=LNAME_"^"_FNAME_"^"_MNAME_"^"_SUFFIX_"^"_PREFIX
  1. Q RES
  1. ;
  1. ADDRESS(GL) ;returns delimited string - address line 1^address line 2^city^state^postal code^country code
  1. N ADL1,ADL2,CITY,STATE,POSTAL,COUNTRYC,RES
  1. S ADL1=$G(@GL@("AddressLine1",0))
  1. S ADL2=$G(@GL@("AddressLine2",0))
  1. S CITY=$G(@GL@("City",0))
  1. S STATE=$G(@GL@("StateProvince",0))
  1. S POSTAL=$G(@GL@("PostalCode",0))
  1. S COUNTRYC=$G(@GL@("CountryCode",0))
  1. S RES=ADL1_"^"_ADL2_"^"_CITY_"^"_STATE_"^"_POSTAL_"^"_COUNTRYC
  1. Q RES
  1. ;
  1. ; GL - The global location of the source of the XML global leading up to the Communication Numbers Multiple (provide example)
  1. ; FILE - The file or subfile number where the data will be stored
  1. ; IEN - The ien of the entry for which the communication values will be stored
  1. ; DAFIL - The top level file number where the direct address information will be stored for this entry
  1. ; DAFLD - The top level field number where the direct address information will be stored for this entry
  1. ;
  1. COMM(GL,SFILE,IEN,DAFIL,DAFLD) ;parses and files communication information into appropriate communication multiple
  1. N TYPE,SEQUENCE,NUM,EXT,SMS,EMAIL,FDA,I,IENS
  1. S SEQUENCE=0,IENS=IEN_","
  1. F TYPE="PrimaryTelephone","Beeper","ElectronicMail","Fax","HomeTelephone","WorkTelephone","OtherTelephone","DirectAddress" D
  1. .I TYPE="DirectAddress" D Q
  1. ..S FDA(DAFIL,IENS,DAFLD)=$G(@GL@("CommunicationNumbers",0,TYPE,0)) D FILE^DIE(,"FDA") K FDA
  1. .S I=-1
  1. .F S I=$O(@GL@("CommunicationNumbers",0,TYPE,I)) Q:I="" D
  1. ..S SEQUENCE=$G(SEQUENCE)+1,(EMAIL,NUM,EXT,SMS)=""
  1. ..S NUM=$G(@GL@("CommunicationNumbers",0,TYPE,I,"Number",0))
  1. ..S EXT=$G(@GL@("CommunicationNumbers",0,TYPE,I,"Extension",0))
  1. ..S SMS=$G(@GL@("CommunicationNumbers",0,TYPE,I,"SupportsSMS",0))
  1. ..I TYPE="ElectronicMail" D
  1. ...S EMAIL=$G(@GL@("CommunicationNumbers",0,TYPE,I))
  1. ...S FDA(SFILE,"+"_SEQUENCE_","_IENS,1)=$G(EMAIL)
  1. ..S FDA(SFILE,"+"_SEQUENCE_","_IENS,.01)=$G(SEQUENCE)
  1. ..S FDA(SFILE,"+"_SEQUENCE_","_IENS,.02)=$$INTERNAL(TYPE)
  1. ..S FDA(SFILE,"+"_SEQUENCE_","_IENS,.03)=$G(NUM)
  1. ..S FDA(SFILE,"+"_SEQUENCE_","_IENS,.04)=$G(EXT)
  1. ..S FDA(SFILE,"+"_SEQUENCE_","_IENS,.05)=$G(SMS)
  1. ..D UPDATE^DIE(,"FDA") K FDA
  1. Q
  1. ;
  1. INTERNAL(TYPE) ;returns internal format for communication type
  1. N DONE,CODES,I,CINT
  1. S DONE=0
  1. S CODES=$P(^DD(52.4613,.02,0),U,3)
  1. F I=1:1 Q:DONE D
  1. .I $P(CODES,";",I)="" S DONE=1 Q
  1. .I $P(CODES,";",I)[TYPE S CINT=$P($P(CODES,";",I),":")
  1. Q CINT
  1. ;
  1. CFDA(CFDA) ;
  1. N FIL,IENS,FLD
  1. S FIL=0 F S FIL=$O(CFDA(FIL)) Q:'FIL D
  1. .S IENS="" F S IENS=$O(CFDA(FIL,IENS)) Q:IENS="" D
  1. ..S FLD=.01 F S FLD=$O(CFDA(FIL,IENS,FLD)) Q:'FLD D
  1. ...I $G(CFDA(FIL,IENS,FLD))="" K CFDA(FIL,IENS,FLD)
  1. Q
  1. ; FIND BODY HEIGHT/WEIGHT IN OBSERVATION
  1. BHW(ERXIEN) ;
  1. N OBS,IENS,LCODE,LDATA,HEIGHT,HUOM,WEIGHT,WUOM,HOBDT,WOBDT,RET,IEN
  1. S IEN=0 F S IEN=$O(^PS(52.49,ERXIEN,306,IEN)) Q:'IEN D
  1. .S IENS=IEN_","_ERXIEN_","
  1. .S LCODE=$$GET1^DIQ(52.49306,IENS,1,"E")
  1. .Q:'LCODE
  1. .D CSDATA^ETSLNC(LCODE,"LNC",DT,.LDATA)
  1. .I $G(LDATA("LEX",1))["BODY HEIGHT" D
  1. ..S HEIGHT=$$GET1^DIQ(52.49306,IENS,3,"E")
  1. ..S HUOM=$$UP^XLFSTR($$GET1^DIQ(52.49306,IENS,4,"E"))
  1. ..S HOBDT=$P($$GET1^DIQ(52.49306,IENS,6,"I"),"."),HOBDT=$$FMTE^XLFDT(HOBDT,"5Z")
  1. ..I HUOM["IN" S HEIGHT=HEIGHT*2.54,$P(HEIGHT,".",2)=$E($P(HEIGHT,".",2),1,2)
  1. .I $G(LDATA("LEX",1))["BODY WEIGHT" D
  1. ..S WEIGHT=$$GET1^DIQ(52.49306,IENS,3,"E")
  1. ..S WOBDT=$P($$GET1^DIQ(52.49306,IENS,6,"I"),"."),WOBDT=$$FMTE^XLFDT(WOBDT,"5Z")
  1. ..S WUOM=$$UP^XLFSTR($$GET1^DIQ(52.49306,IENS,4,"E"))
  1. ..I WUOM["LB" S WEIGHT=WEIGHT/2.2046,$P(WEIGHT,".",2)=$E($P(WEIGHT,".",2),1,2)
  1. .K LDATA
  1. S RET="eRx HT: "_$G(HEIGHT)_"(cm)("_$G(HOBDT)_") eRx WT: "_$G(WEIGHT)_"(kg)("_$G(WOBDT)_")"
  1. Q RET