PSOERXOC ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
;;7.0;OUTPATIENT PHARMACY;**581**;DEC 1997;Build 126
;
Q
PATIENT(GBL,CNT,PSOSITE,IEN) ;
N F,PATREL,LNAME,FNAME,MNAME,SUFF,PREF,GENDER,DOB,ADDL1,ADDL2,CITY,STATE,ZIP,PLQ,CUNIT,BED,ROOM,PSDAT,ILOOP
N ITYP,IVAL,CLOOP,CNUM,CQUAL,PIEN,PIENS,PSSN,LANGNC,GESTAGE,HOSPIND,ACLN,ACFN,ACMN,ACSUFF,ACPREF,ACRELAT,ACFLN
N ACFFN,ACFMN,ACFSUFF,ACFPREF,ACADL1,ACADL2,ACCITY,ACSTATE,ACPOSTAL,ACCC,DIRADD,ALDIRADD,MEDICARE,MEDICAID,MEDICAL,ACCNUM,MUTDEF,REMS
N ASGBL,CC,FOFN,FOLN,FOMN,FOPREF,FOSUFF,SGBL
S F=52.46
S PIEN=$$GET1^DIQ(52.49,IEN,.04,"I") Q:'PIEN
S PIENS=PIEN_","
D GETS^DIQ(F,PIENS,"**","IE","PSDAT")
D CONVXML^PSOERXX1("PSDAT")
S PATREL=$G(PSDAT(F,PIENS,1.7,"I"))
S LNAME=$G(PSDAT(F,PIENS,.02,"E"))
S FNAME=$G(PSDAT(F,PIENS,.03,"E"))
S MNAME=$G(PSDAT(F,PIENS,.04,"E"))
S SUFF=$G(PSDAT(F,PIENS,.05,"E"))
S PREF=$G(PSDAT(F,PIENS,.06,"E"))
S GENDER=$G(PSDAT(F,PIENS,.07,"I"))
S DOB=$G(PSDAT(F,PIENS,.08,"I")) I $G(DOB) S DOB=$P($$EXTIME^PSOERXO1(DOB),"T")
S ADDL1=$G(PSDAT(F,PIENS,3.1,"E"))
S ADDL2=$G(PSDAT(F,PIENS,3.2,"E"))
S CITY=$G(PSDAT(F,PIENS,3.3,"E"))
S STATE=$G(PSDAT(F,PIENS,3.4,"I"))
S ZIP=$G(PSDAT(F,PIENS,3.5,"E"))
S CC=$G(PSDAT(F,PIENS,1.6,"E"))
S PSSN=$G(PSDAT(F,PIENS,18.2,"E"))
; FUTURE ENHANCEMENT, GRAB CUNIT/BED/ROOM FROM CORRECT LOCATIONS. THIS LOGIC IS NOT ACTIVE WITH VERSION 2
S CUNIT=$G(PSDAT(F,PIENS,8.1,"E")) ; 8.1
S BED=$G(PSDAT(F,PIENS,8.2,"E")) ; 8.3
S ROOM=$G(PSDAT(F,PIENS,8.3,"E")) ; 8.2
;
;start grabbing 2017 variables
;
S FOLN=$G(PSDAT(F,PIENS,7.1,"E"))
S FOFN=$G(PSDAT(F,PIENS,7.2,"E"))
S FOMN=$G(PSDAT(F,PIENS,7.3,"E"))
S FOSUFF=$G(PSDAT(F,PIENS,7.4,"E"))
S FOPREF=$G(PSDAT(F,PIENS,7.5,"E"))
S LANGNC=$G(PSDAT(F,PIENS,8.4,"E"))
S GESTAGE=$G(PSDAT(F,PIENS,8.5,"E"))
S HOSPIND=$G(PSDAT(F,PIENS,8.6,"I"))
S ACLN=$G(PSDAT(F,PIENS,9.1,"E"))
S ACFN=$G(PSDAT(F,PIENS,9.2,"E"))
S ACMN=$G(PSDAT(F,PIENS,9.3,"E"))
S ACSUFF=$G(PSDAT(F,PIENS,9.4,"E"))
S ACPREF=$G(PSDAT(F,PIENS,9.5,"E"))
S ACRELAT=$G(PSDAT(F,PIENS,9.6,"I")),ACRELAT=$$GET1^DIQ(52.45,ACRELAT,.01,"E")
S ACFLN=$G(PSDAT(F,PIENS,10.1,"E"))
S ACFFN=$G(PSDAT(F,PIENS,10.2,"E"))
S ACFMN=$G(PSDAT(F,PIENS,10.3,"E"))
S ACFSUFF=$G(PSDAT(F,PIENS,10.4,"E"))
S ACFPREF=$G(PSDAT(F,PIENS,10.5,"E"))
S ACADL1=$G(PSDAT(F,PIENS,11.1,"E"))
S ACADL2=$G(PSDAT(F,PIENS,11.2,"E"))
S ACCITY=$G(PSDAT(F,PIENS,11.3,"E"))
S ACSTATE=$G(PSDAT(F,PIENS,11.4,"I"))
S ACPOSTAL=$G(PSDAT(F,PIENS,11.5,"E"))
S ACCC=$G(PSDAT(F,PIENS,11.6,"E"))
;alternate communication
S ASGBL=$NA(^PS(52.46,IEN,15))
S ALDIRADD=$G(PSDAT(F,PIENS,16,"E"))
S MEDICARE=$G(PSDAT(F,PIENS,17.1,"E"))
S MEDICAID=$G(PSDAT(F,PIENS,17.2,"E"))
S MEDICAL=$G(PSDAT(F,PIENS,17.3,"E"))
S ACCNUM=$G(PSDAT(F,PIENS,18.1,"E"))
S MUTDEF=$G(PSDAT(F,PIENS,18.3,"E"))
S REMS=$G(PSDAT(F,PIENS,18.4,"E"))
;end 2017 variables
;
;new outbound building - 12/9/19
;
D C S @GBL@(CNT,0)="<Patient>"
D C S @GBL@(CNT,0)="<HumanPatient>"
I $L(MEDICARE_MEDICAID_MEDICAL_ACCNUM_PSSN_MUTDEF_REMS) D
.D C S @GBL@(CNT,0)="<Identification>"
.D BL(GBL,.CNT,"MedicareNumber",MEDICARE)
.D BL(GBL,.CNT,"MedicaidNumber",MEDICAID)
.D BL(GBL,.CNT,"MedicalRecordIdentificationNumberEHR",MEDICAL)
.D BL(GBL,.CNT,"PatientAccountNumber",ACCNUM)
.D BL(GBL,.CNT,"SocialSecurity",PSSN)
.D BL(GBL,.CNT,"MutuallyDefined",MUTDEF)
.D BL(GBL,.CNT,"REMSPatientID",REMS)
.D C S @GBL@(CNT,0)="</Identification>"
D ONAME^PSOERXOU(GBL,.CNT,"Name",LNAME,FNAME,MNAME,SUFF,PREF)
I $L(FOLN) D
.D ONAME^PSOERXOU(GBL,.CNT,"FormerName",FOLN,FOFN,FOMN,FOSUFF,FOPREF)
D BL(GBL,.CNT,"Gender",GENDER)
D C S @GBL@(CNT,0)="<DateOfBirth>"
D BL(GBL,.CNT,"Date",DOB)
D C S @GBL@(CNT,0)="</DateOfBirth>"
D OADD^PSOERXOU(GBL,.CNT,ADDL1,ADDL2,CITY,STATE,ZIP,CC)
S SGBL=$NA(^PS(52.46,PIEN,13))
D OCOMM^PSOERXOU(GBL,SGBL,.CNT,PIEN_",",52.4613,52.46,14,PIEN_",")
I $L(CUNIT_BED_ROOM) D
.D C S @GBL@(CNT,0)="<PatientLocation>"
.D BL(GBL,.CNT,"FacilityUnit",CUNIT)
.D BL(GBL,.CNT,"BED",BED)
.D BL(GBL,.CNT,"Room",ROOM)
.D C S @GBL@(CNT,0)="</PatientLocation>"
.D BL(GBL,.CNT,"LanguageNameCode",LANGNC)
D SUBSTNCE(PIEN,52.4619,GBL)
I $L(ACLN) D
.D C S @GBL@(CNT,0)="<AlternateContact>"
.D ONAME^PSOERXOU(GBL,.CNT,"Name",ACLN,ACFN,ACMN,ACSUFF,ACPREF)
.I $L(ACFLN) D
..D ONAME^PSOERXOU(GBL,.CNT,"FormerName",ACFLN,ACFFN,ACFMN,ACFPREF,ACFSUFF)
.D OADD^PSOERXOU(GBL,.CNT,ACADL1,ACADL2,ACCITY,ACSTATE,ACPOSTAL,ACCC)
.S SGBL=$NA(^PS(52.46,PIEN,15))
.D OCOMM^PSOERXOU(GBL,SGBL,.CNT,PIEN_",",52.4615,52.46,16,PIEN_",")
.D BL(GBL,.CNT,"AlternateContactRelationship",ACRELAT)
.D C S @GBL@(CNT,0)="</AlternateContact>"
.D BL(GBL,.CNT,"GestationalAge",GESTAGE)
.D BL(GBL,.CNT,"HospiceIndicator",HOSPIND)
;end new outbound building
D C S @GBL@(CNT,0)="</HumanPatient>"
D C S @GBL@(CNT,0)="</Patient>"
Q
SUBSTNCE(PIEN,SFILE,GBL) ; patient substance (52.4619)
N SFIEN,SUBIENS,TYPETEXT,TYPEQUAL,TYPECODE,LEVTEXT
N LEVQUAL,LEVCODE,ROATEXT,ROAQUAL,ROACODE,SUBDAT
S SFIEN=0,IEN=5531,SFILE=52.4619
Q:'$O(^PS(52.46,PIEN,19,0))
F S SFIEN=$O(^PS(52.46,PIEN,19,SFIEN)) Q:'SFIEN D
.S SUBIENS=SFIEN_","_PIEN_","
.D GETS^DIQ(52.4619,SUBIENS,"**","E","SUBDAT")
.S TYPETEXT=$G(SUBDAT(SFILE,SUBIENS,1,"E"))
.S TYPEQUAL=$G(SUBDAT(SFILE,SUBIENS,2,"E"))
.S TYPECODE=$G(SUBDAT(SFILE,SUBIENS,3,"E"))
.S LEVTEXT=$G(SUBDAT(SFILE,SUBIENS,4,"E"))
.S LEVQUAL=$G(SUBDAT(SFILE,SUBIENS,5,"E"))
.S LEVCODE=$G(SUBDAT(SFILE,SUBIENS,6,"E"))
.S ROATEXT=$G(SUBDAT(SFILE,SUBIENS,7,"E"))
.S ROAQUAL=$G(SUBDAT(SFILE,SUBIENS,8,"E"))
.S ROACODE=$G(SUBDAT(SFILE,SUBIENS,9,"E"))
.I $L(TYPETEXT_TYPEQUAL_TYPECODE_LEVTEXT_LEVQUAL_LEVCODE_ROATEXT_ROAQUAL_ROACODE) D
..D C S @GBL@(CNT,0)="<SubstanceUse>"
..D C S @GBL@(CNT,0)="<Substance>"
..D C S @GBL@(CNT,0)="<Type>"
..D BL(GBL,.CNT,"Text",TYPETEXT)
..D BL(GBL,.CNT,"Qualifier",TYPEQUAL)
..D BL(GBL,.CNT,"Code",TYPECODE)
..D C S @GBL@(CNT,0)="</Type>"
..I $L(LEVTEXT_LEVQUAL_LEVCODE) D
...D C S @GBL@(CNT,0)="<Level>"
...D BL(GBL,.CNT,"Text",LEVTEXT)
...D BL(GBL,.CNT,"Qualifier",LEVQUAL)
...D BL(GBL,.CNT,"Code",LEVCODE)
...D C S @GBL@(CNT,0)="</Level>"
..I $L(ROATEXT_ROAQUAL_ROACODE) D
...D C S @GBL@(CNT,0)="<RouteOfAdministration>"
...D BL(GBL,.CNT,"Text",ROATEXT)
...D BL(GBL,.CNT,"Qualifier",ROAQUAL)
...D BL(GBL,.CNT,"Code",ROACODE)
...D C S @GBL@(CNT,0)="</RouteOfAdministration>"
..D C S @GBL@(CNT,0)="</Substance>"
..D C S @GBL@(CNT,0)="</SubstanceUse>"
Q
BL(GBL,CNT,TAG,VAR) ;
Q:VAR=""
D C S @GBL@(CNT,0)="<"_TAG_">"_$$SYMENC^MXMLUTL(VAR)_"</"_TAG_">"
Q
C ;
S CNT=$G(CNT)+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXOC 6717 printed Apr 09, 2024@21:36:30 Page 2
PSOERXOC ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
+1 ;;7.0;OUTPATIENT PHARMACY;**581**;DEC 1997;Build 126
+2 ;
+3 QUIT
PATIENT(GBL,CNT,PSOSITE,IEN) ;
+1 NEW F,PATREL,LNAME,FNAME,MNAME,SUFF,PREF,GENDER,DOB,ADDL1,ADDL2,CITY,STATE,ZIP,PLQ,CUNIT,BED,ROOM,PSDAT,ILOOP
+2 NEW ITYP,IVAL,CLOOP,CNUM,CQUAL,PIEN,PIENS,PSSN,LANGNC,GESTAGE,HOSPIND,ACLN,ACFN,ACMN,ACSUFF,ACPREF,ACRELAT,ACFLN
+3 NEW ACFFN,ACFMN,ACFSUFF,ACFPREF,ACADL1,ACADL2,ACCITY,ACSTATE,ACPOSTAL,ACCC,DIRADD,ALDIRADD,MEDICARE,MEDICAID,MEDICAL,ACCNUM,MUTDEF,REMS
+4 NEW ASGBL,CC,FOFN,FOLN,FOMN,FOPREF,FOSUFF,SGBL
+5 SET F=52.46
+6 SET PIEN=$$GET1^DIQ(52.49,IEN,.04,"I")
if 'PIEN
QUIT
+7 SET PIENS=PIEN_","
+8 DO GETS^DIQ(F,PIENS,"**","IE","PSDAT")
+9 DO CONVXML^PSOERXX1("PSDAT")
+10 SET PATREL=$GET(PSDAT(F,PIENS,1.7,"I"))
+11 SET LNAME=$GET(PSDAT(F,PIENS,.02,"E"))
+12 SET FNAME=$GET(PSDAT(F,PIENS,.03,"E"))
+13 SET MNAME=$GET(PSDAT(F,PIENS,.04,"E"))
+14 SET SUFF=$GET(PSDAT(F,PIENS,.05,"E"))
+15 SET PREF=$GET(PSDAT(F,PIENS,.06,"E"))
+16 SET GENDER=$GET(PSDAT(F,PIENS,.07,"I"))
+17 SET DOB=$GET(PSDAT(F,PIENS,.08,"I"))
IF $GET(DOB)
SET DOB=$PIECE($$EXTIME^PSOERXO1(DOB),"T")
+18 SET ADDL1=$GET(PSDAT(F,PIENS,3.1,"E"))
+19 SET ADDL2=$GET(PSDAT(F,PIENS,3.2,"E"))
+20 SET CITY=$GET(PSDAT(F,PIENS,3.3,"E"))
+21 SET STATE=$GET(PSDAT(F,PIENS,3.4,"I"))
+22 SET ZIP=$GET(PSDAT(F,PIENS,3.5,"E"))
+23 SET CC=$GET(PSDAT(F,PIENS,1.6,"E"))
+24 SET PSSN=$GET(PSDAT(F,PIENS,18.2,"E"))
+25 ; FUTURE ENHANCEMENT, GRAB CUNIT/BED/ROOM FROM CORRECT LOCATIONS. THIS LOGIC IS NOT ACTIVE WITH VERSION 2
+26 ; 8.1
SET CUNIT=$GET(PSDAT(F,PIENS,8.1,"E"))
+27 ; 8.3
SET BED=$GET(PSDAT(F,PIENS,8.2,"E"))
+28 ; 8.2
SET ROOM=$GET(PSDAT(F,PIENS,8.3,"E"))
+29 ;
+30 ;start grabbing 2017 variables
+31 ;
+32 SET FOLN=$GET(PSDAT(F,PIENS,7.1,"E"))
+33 SET FOFN=$GET(PSDAT(F,PIENS,7.2,"E"))
+34 SET FOMN=$GET(PSDAT(F,PIENS,7.3,"E"))
+35 SET FOSUFF=$GET(PSDAT(F,PIENS,7.4,"E"))
+36 SET FOPREF=$GET(PSDAT(F,PIENS,7.5,"E"))
+37 SET LANGNC=$GET(PSDAT(F,PIENS,8.4,"E"))
+38 SET GESTAGE=$GET(PSDAT(F,PIENS,8.5,"E"))
+39 SET HOSPIND=$GET(PSDAT(F,PIENS,8.6,"I"))
+40 SET ACLN=$GET(PSDAT(F,PIENS,9.1,"E"))
+41 SET ACFN=$GET(PSDAT(F,PIENS,9.2,"E"))
+42 SET ACMN=$GET(PSDAT(F,PIENS,9.3,"E"))
+43 SET ACSUFF=$GET(PSDAT(F,PIENS,9.4,"E"))
+44 SET ACPREF=$GET(PSDAT(F,PIENS,9.5,"E"))
+45 SET ACRELAT=$GET(PSDAT(F,PIENS,9.6,"I"))
SET ACRELAT=$$GET1^DIQ(52.45,ACRELAT,.01,"E")
+46 SET ACFLN=$GET(PSDAT(F,PIENS,10.1,"E"))
+47 SET ACFFN=$GET(PSDAT(F,PIENS,10.2,"E"))
+48 SET ACFMN=$GET(PSDAT(F,PIENS,10.3,"E"))
+49 SET ACFSUFF=$GET(PSDAT(F,PIENS,10.4,"E"))
+50 SET ACFPREF=$GET(PSDAT(F,PIENS,10.5,"E"))
+51 SET ACADL1=$GET(PSDAT(F,PIENS,11.1,"E"))
+52 SET ACADL2=$GET(PSDAT(F,PIENS,11.2,"E"))
+53 SET ACCITY=$GET(PSDAT(F,PIENS,11.3,"E"))
+54 SET ACSTATE=$GET(PSDAT(F,PIENS,11.4,"I"))
+55 SET ACPOSTAL=$GET(PSDAT(F,PIENS,11.5,"E"))
+56 SET ACCC=$GET(PSDAT(F,PIENS,11.6,"E"))
+57 ;alternate communication
+58 SET ASGBL=$NAME(^PS(52.46,IEN,15))
+59 SET ALDIRADD=$GET(PSDAT(F,PIENS,16,"E"))
+60 SET MEDICARE=$GET(PSDAT(F,PIENS,17.1,"E"))
+61 SET MEDICAID=$GET(PSDAT(F,PIENS,17.2,"E"))
+62 SET MEDICAL=$GET(PSDAT(F,PIENS,17.3,"E"))
+63 SET ACCNUM=$GET(PSDAT(F,PIENS,18.1,"E"))
+64 SET MUTDEF=$GET(PSDAT(F,PIENS,18.3,"E"))
+65 SET REMS=$GET(PSDAT(F,PIENS,18.4,"E"))
+66 ;end 2017 variables
+67 ;
+68 ;new outbound building - 12/9/19
+69 ;
+70 DO C
SET @GBL@(CNT,0)="<Patient>"
+71 DO C
SET @GBL@(CNT,0)="<HumanPatient>"
+72 IF $LENGTH(MEDICARE_MEDICAID_MEDICAL_ACCNUM_PSSN_MUTDEF_REMS)
Begin DoDot:1
+73 DO C
SET @GBL@(CNT,0)="<Identification>"
+74 DO BL(GBL,.CNT,"MedicareNumber",MEDICARE)
+75 DO BL(GBL,.CNT,"MedicaidNumber",MEDICAID)
+76 DO BL(GBL,.CNT,"MedicalRecordIdentificationNumberEHR",MEDICAL)
+77 DO BL(GBL,.CNT,"PatientAccountNumber",ACCNUM)
+78 DO BL(GBL,.CNT,"SocialSecurity",PSSN)
+79 DO BL(GBL,.CNT,"MutuallyDefined",MUTDEF)
+80 DO BL(GBL,.CNT,"REMSPatientID",REMS)
+81 DO C
SET @GBL@(CNT,0)="</Identification>"
End DoDot:1
+82 DO ONAME^PSOERXOU(GBL,.CNT,"Name",LNAME,FNAME,MNAME,SUFF,PREF)
+83 IF $LENGTH(FOLN)
Begin DoDot:1
+84 DO ONAME^PSOERXOU(GBL,.CNT,"FormerName",FOLN,FOFN,FOMN,FOSUFF,FOPREF)
End DoDot:1
+85 DO BL(GBL,.CNT,"Gender",GENDER)
+86 DO C
SET @GBL@(CNT,0)="<DateOfBirth>"
+87 DO BL(GBL,.CNT,"Date",DOB)
+88 DO C
SET @GBL@(CNT,0)="</DateOfBirth>"
+89 DO OADD^PSOERXOU(GBL,.CNT,ADDL1,ADDL2,CITY,STATE,ZIP,CC)
+90 SET SGBL=$NAME(^PS(52.46,PIEN,13))
+91 DO OCOMM^PSOERXOU(GBL,SGBL,.CNT,PIEN_",",52.4613,52.46,14,PIEN_",")
+92 IF $LENGTH(CUNIT_BED_ROOM)
Begin DoDot:1
+93 DO C
SET @GBL@(CNT,0)="<PatientLocation>"
+94 DO BL(GBL,.CNT,"FacilityUnit",CUNIT)
+95 DO BL(GBL,.CNT,"BED",BED)
+96 DO BL(GBL,.CNT,"Room",ROOM)
+97 DO C
SET @GBL@(CNT,0)="</PatientLocation>"
+98 DO BL(GBL,.CNT,"LanguageNameCode",LANGNC)
End DoDot:1
+99 DO SUBSTNCE(PIEN,52.4619,GBL)
+100 IF $LENGTH(ACLN)
Begin DoDot:1
+101 DO C
SET @GBL@(CNT,0)="<AlternateContact>"
+102 DO ONAME^PSOERXOU(GBL,.CNT,"Name",ACLN,ACFN,ACMN,ACSUFF,ACPREF)
+103 IF $LENGTH(ACFLN)
Begin DoDot:2
+104 DO ONAME^PSOERXOU(GBL,.CNT,"FormerName",ACFLN,ACFFN,ACFMN,ACFPREF,ACFSUFF)
End DoDot:2
+105 DO OADD^PSOERXOU(GBL,.CNT,ACADL1,ACADL2,ACCITY,ACSTATE,ACPOSTAL,ACCC)
+106 SET SGBL=$NAME(^PS(52.46,PIEN,15))
+107 DO OCOMM^PSOERXOU(GBL,SGBL,.CNT,PIEN_",",52.4615,52.46,16,PIEN_",")
+108 DO BL(GBL,.CNT,"AlternateContactRelationship",ACRELAT)
+109 DO C
SET @GBL@(CNT,0)="</AlternateContact>"
+110 DO BL(GBL,.CNT,"GestationalAge",GESTAGE)
+111 DO BL(GBL,.CNT,"HospiceIndicator",HOSPIND)
End DoDot:1
+112 ;end new outbound building
+113 DO C
SET @GBL@(CNT,0)="</HumanPatient>"
+114 DO C
SET @GBL@(CNT,0)="</Patient>"
+115 QUIT
SUBSTNCE(PIEN,SFILE,GBL) ; patient substance (52.4619)
+1 NEW SFIEN,SUBIENS,TYPETEXT,TYPEQUAL,TYPECODE,LEVTEXT
+2 NEW LEVQUAL,LEVCODE,ROATEXT,ROAQUAL,ROACODE,SUBDAT
+3 SET SFIEN=0
SET IEN=5531
SET SFILE=52.4619
+4 if '$ORDER(^PS(52.46,PIEN,19,0))
QUIT
+5 FOR
SET SFIEN=$ORDER(^PS(52.46,PIEN,19,SFIEN))
if 'SFIEN
QUIT
Begin DoDot:1
+6 SET SUBIENS=SFIEN_","_PIEN_","
+7 DO GETS^DIQ(52.4619,SUBIENS,"**","E","SUBDAT")
+8 SET TYPETEXT=$GET(SUBDAT(SFILE,SUBIENS,1,"E"))
+9 SET TYPEQUAL=$GET(SUBDAT(SFILE,SUBIENS,2,"E"))
+10 SET TYPECODE=$GET(SUBDAT(SFILE,SUBIENS,3,"E"))
+11 SET LEVTEXT=$GET(SUBDAT(SFILE,SUBIENS,4,"E"))
+12 SET LEVQUAL=$GET(SUBDAT(SFILE,SUBIENS,5,"E"))
+13 SET LEVCODE=$GET(SUBDAT(SFILE,SUBIENS,6,"E"))
+14 SET ROATEXT=$GET(SUBDAT(SFILE,SUBIENS,7,"E"))
+15 SET ROAQUAL=$GET(SUBDAT(SFILE,SUBIENS,8,"E"))
+16 SET ROACODE=$GET(SUBDAT(SFILE,SUBIENS,9,"E"))
+17 IF $LENGTH(TYPETEXT_TYPEQUAL_TYPECODE_LEVTEXT_LEVQUAL_LEVCODE_ROATEXT_ROAQUAL_ROACODE)
Begin DoDot:2
+18 DO C
SET @GBL@(CNT,0)="<SubstanceUse>"
+19 DO C
SET @GBL@(CNT,0)="<Substance>"
+20 DO C
SET @GBL@(CNT,0)="<Type>"
+21 DO BL(GBL,.CNT,"Text",TYPETEXT)
+22 DO BL(GBL,.CNT,"Qualifier",TYPEQUAL)
+23 DO BL(GBL,.CNT,"Code",TYPECODE)
+24 DO C
SET @GBL@(CNT,0)="</Type>"
+25 IF $LENGTH(LEVTEXT_LEVQUAL_LEVCODE)
Begin DoDot:3
+26 DO C
SET @GBL@(CNT,0)="<Level>"
+27 DO BL(GBL,.CNT,"Text",LEVTEXT)
+28 DO BL(GBL,.CNT,"Qualifier",LEVQUAL)
+29 DO BL(GBL,.CNT,"Code",LEVCODE)
+30 DO C
SET @GBL@(CNT,0)="</Level>"
End DoDot:3
+31 IF $LENGTH(ROATEXT_ROAQUAL_ROACODE)
Begin DoDot:3
+32 DO C
SET @GBL@(CNT,0)="<RouteOfAdministration>"
+33 DO BL(GBL,.CNT,"Text",ROATEXT)
+34 DO BL(GBL,.CNT,"Qualifier",ROAQUAL)
+35 DO BL(GBL,.CNT,"Code",ROACODE)
+36 DO C
SET @GBL@(CNT,0)="</RouteOfAdministration>"
End DoDot:3
+37 DO C
SET @GBL@(CNT,0)="</Substance>"
+38 DO C
SET @GBL@(CNT,0)="</SubstanceUse>"
End DoDot:2
End DoDot:1
+39 QUIT
BL(GBL,CNT,TAG,VAR) ;
+1 if VAR=""
QUIT
+2 DO C
SET @GBL@(CNT,0)="<"_TAG_">"_$$SYMENC^MXMLUTL(VAR)_"</"_TAG_">"
+3 QUIT
C ;
+1 SET CNT=$GET(CNT)+1
+2 QUIT
