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