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 Dec 13, 2024@02:28:44 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
