PSOERXOL ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
;;7.0;OUTPATIENT PHARMACY;**581**;DEC 1997;Build 126
;
Q
OOPHAFF(GL,CNT,ERXIEN,MIEN) ;outbound office of pharmacy affairs segment
N F,PAIEN,PADAT,PAIENS,PAID
S F=52.4931117
S PAIEN=0 F S PAIEN=$O(^PS(52.49,ERXIEN,311,MIEN,17,PAIEN)) Q:'PAIEN D
.K PADAT
.S PAIENS=PAIEN_","_MIEN_","_ERXIEN_","
.D GETS^DIQ(F,PAIENS,"**","IE","PADAT")
.S PAID=$G(PADAT(F,PAIENS,.02,"E"))
.D BL(GBL,.CNT,"OfficeOfPharmacyAffairsID",PAID)
Q
OWOUND(GL,CNT,ERXIEN,MIEN) ;outbound wound segment
N WIEN,WDAT,WIENS,LOCCODE,LOCTEXT,LATCODE,LATTEXT,LENGTH,WIDTH,DEPTH
I '$O(^PS(52.49,ERXIEN,311,MIEN,46,0)) Q
S F=52.4931146
S WIEN=0 F S WIEN=$O(^PS(52.49,ERXIEN,311,MIEN,46,WIEN)) Q:'WIEN D
.K WDAT
.S WIENS=WIEN_","_MIEN_","_ERXIEN_","
.D GETS^DIQ(F,WIENS,"**","IE","WDAT")
.S LOCCODE=$G(WDAT(F,WIENS,.02,"E"))
.S LOCTEXT=$G(WDAT(F,WIENS,1,"E"))
.S LATCODE=$G(WDAT(F,WIENS,2.1,"I"))
.S LATTEXT=$G(WDAT(F,WIENS,3,"E"))
.S LENGTH=$G(WDAT(F,WIENS,4.1,"E"))
.S WIDTH=$G(WDAT(F,WIENS,4.2,"E"))
.S DEPTH=$G(WDAT(F,WIENS,4.3,"E"))
.D C S @GBL@(CNT,0)="<Wound>"
.D C S @GBL@(CNT,0)="<Location>"
.D BL(GBL,.CNT,"Text",LOCTEXT)
.D BL(GBL,.CNT,"Code",LOCCODE)
.D C S @GBL@(CNT,0)="</Location>"
.D C S @GBL@(CNT,0)="<Laterality>"
.D BL(GBL,.CNT,"Text",LATTEXT)
.D BL(GBL,.CNT,"Code",LATCODE)
.D C S @GBL@(CNT,0)="</Laterality>"
.D BL(GBL,.CNT,"Length",LENGTH)
.D BL(GBL,.CNT,"Width",WIDTH)
.D BL(GBL,.CNT,"Depth",DEPTH)
.D C S @GBL@(CNT,0)="</Wound>"
Q
OIVA(GBL,CNT,ERXIEN,MIEN) ; outbound IV administration segment
N NUMLUMEN,DILQTY,DILQUAL,DILQUOM,ADMINGAU,ADMINBR,ADMINLEN,ADMINPMP,TYPECODE,TYPETEXT,DEVDESC,DEVCODE,DEVTEXT,TIPCODE,TIPTEXT
N TIPDESC,INFUCODE,INFUTEXT,INFUDESC,IENS,IVDAT
S F=52.49311
S IENS=MIEN_","_ERXIEN_","
D GETS^DIQ(F,IENS,"**","IE","IVDAT")
S NUMLUMEN=$G(IVDAT(F,IENS,28,"E"))
S DILQTY=$G(IVDAT(F,IENS,29.1,"E"))
S DILQUAL=$G(IVDAT(F,IENS,29.2,"E"))
S DILQUOM=$G(IVDAT(F,IENS,29.3,"E"))
S ADMINGAU=$G(IVDAT(F,IENS,30,"E"))
S ADMINBR=$G(IVDAT(F,IENS,31,"E"))
S ADMINLEN=$G(IVDAT(F,IENS,32,"E"))
S ADMINPMP=$G(IVDAT(F,IENS,33.1,"I"))
S TYPECODE=$G(IVDAT(F,IENS,34.1,"E"))
S TYPETEXT=$G(IVDAT(F,IENS,35,"E"))
S DEVDESC=$G(IVDAT(F,IENS,36,"E"))
S DEVCODE=$G(IVDAT(F,IENS,37.1,"E"))
S DEVTEXT=$G(IVDAT(F,IENS,38,"E"))
S TIPCODE=$G(IVDAT(F,IENS,39.1,"E"))
S TIPTEXT=$G(IVDAT(F,IENS,40,"E"))
S TIPDESC=$G(IVDAT(F,IENS,41,"E"))
S INFUCODE=$G(IVDAT(F,IENS,42.1,"E"))
S INFUTEXT=$G(IVDAT(F,IENS,43,"E"))
S INFUDESC=$G(IVDAT(F,IENS,44,"E"))
I $L(TYPETEXT) D
.D C S @GBL@(CNT,0)="<IVAdministration>"
D BL(GBL,.CNT,"NumberOfLumens",NUMLUMEN)
I $L(DILQTY_DILQUAL_DILQUOM) D
.D C S @GBL@(CNT,0)="<DiluentAmount>"
.D BL(GBL,.CNT,"Value",DILQTY)
.D BL(GBL,.CNT,"CodeListQualifier",DILQUAL)
.I $L(DILQUOM) D
..D C S @GBL@(CNT,0)="<QuantityUnitOfMeasure>"
..D BL(GBL,.CNT,"Code",DILQUOM)
..D C S @GBL@(CNT,0)="</QuantityUnitOfMeasure>"
.D C S @GBL@(CNT,0)="</DiluentAmount>"
D BL(GBL,.CNT,"SpecificAdministrationGauge",ADMINGAU)
D BL(GBL,.CNT,"SpecificAdministrationBrand",ADMINBR)
D BL(GBL,.CNT,"SpecificAdministrationLength",ADMINLEN)
D BL(GBL,.CNT,"SpecificAdministrationPump",ADMINPMP)
I $L(TYPETEXT_TYPECODE) D
.D C S @GBL@(CNT,0)="<IVAccessType>"
.D BL(GBL,.CNT,"Text",TYPETEXT)
.D BL(GBL,.CNT,"Code",TYPECODE)
.D C S @GBL@(CNT,0)="</IVAccessType>"
I $L(DEVTEXT_DEVCODE_DEVDESC) D
.D C S @GBL@(CNT,0)="<IVAccessDeviceType>"
.D BL(GBL,.CNT,"IVAccessDeviceTypeDescription",DEVDESC)
.D C S @GBL@(CNT,0)="<IVAccessDeviceType>"
.D BL(GBL,.CNT,"Text",DEVTEXT)
.D BL(GBL,.CNT,"Code",DEVCODE)
.D C S @GBL@(CNT,0)="</IVAccessDeviceType>"
.D C S @GBL@(CNT,0)="</IVAccessDeviceType>"
I $L(TIPDESC_TIPTEXT_TIPCODE) D
.D C S @GBL@(CNT,0)="<IVAccessCatheterTip>"
.D BL(GBL,.CNT,"IVAccessCatheterTipDescription",TIPDESC)
I $L(TIPTEXT_TIPCODE) D
.D C S @GBL@(CNT,0)="<IVAccessCatheterTipType>"
.D BL(GBL,.CNT,"Text",TIPTEXT)
.D BL(GBL,.CNT,"Code",TIPCODE)
.D C S @GBL@(CNT,0)="</IVAccessCatheterTipType>"
.D C S @GBL@(CNT,0)="</IVAccessCatheterTip>"
I $L(INFUDESC_INFUTEXT_INFUCODE) D
.D C S @GBL@(CNT,0)="<IVInfusion>"
.D BL(GBL,.CNT,"IVInfusionDescription",INFUDESC)
I $L(INFUTEXT_INFUCODE) D
.D C S @GBL@(CNT,0)="<IVInfusionType>"
.D BL(GBL,.CNT,"Text",INFUTEXT)
.D BL(GBL,.CNT,"Code",INFUCODE)
.D C S @GBL@(CNT,0)="</IVInfusionType>"
.D C S @GBL@(CNT,0)="</IVInfusion>"
I $L(TYPETEXT) D
.D C S @GBL@(CNT,0)="</IVAdministration>"
Q
OAGENCY(GBL,CNT,ERXIEN,MIEN) ;
N AGNCNAME,AGNCADL1,AGNCADL2,AGNCCITY,AGNCST,AGNCPOST,AGNCCC,AGNCYLN,AGNCYFN,AGNCYMN,AGNCYSUF,AGNCYSUF
N TOSFT,TOST,TOSQUAL,TOSCODE,TARGFT,TARGT,TARGQUAL,TARGCODE,MTMFTEXT,MTMTEXT,MTMQUAL,MTMCODE,MTMCODE,TOSEXP,TOSEFF,TOSGRSET
N AGDAT,AGNCYPRF,SGBL
S F=52.49311
S IENS=MIEN_","_ERXIEN_","
D GETS^DIQ(F,IENS,"21.1;21.2;21.3;21.4;21.5;21.6;21.7;27.1;27.2;27.3;27.4;27.5;64;65;66;67;68;69;71;72;73;74;75;76;77;78;79;81","IE","AGDAT")
S AGNCNAME=$G(AGDAT(F,IENS,21.1,"E"))
S AGNCADL1=$G(AGDAT(F,IENS,21.2,"E"))
S AGNCADL2=$G(AGDAT(F,IENS,21.3,"E"))
S AGNCCITY=$G(AGDAT(F,IENS,21.4,"E"))
S AGNCST=$G(AGDAT(F,IENS,21.5,"I"))
S AGNCPOST=$G(AGDAT(F,IENS,21.6,"E"))
S AGNCCC=$G(AGDAT(F,IENS,21.7,"E"))
S AGNCYLN=$G(AGDAT(F,IENS,27.1,"E"))
S AGNCYFN=$G(AGDAT(F,IENS,27.2,"E"))
S AGNCYMN=$G(AGDAT(F,IENS,27.3,"E"))
S AGNCYSUF=$G(AGDAT(F,IENS,27.4,"E"))
S AGNCYPRF=$G(AGDAT(F,IENS,27.5,"E"))
S TOSFT=$G(AGDAT(F,IENS,64,"E"))
S TOST=$G(AGDAT(F,IENS,65,"E"))
S TOSQUAL=$G(AGDAT(F,IENS,66,"E"))
S TOSCODE=$G(AGDAT(F,IENS,67,"E"))
S TARGFT=$G(AGDAT(F,IENS,68,"E"))
S TARGT=$G(AGDAT(F,IENS,69,"E"))
S TARGQUAL=$G(AGDAT(F,IENS,71,"E"))
S TARGCODE=$G(AGDAT(F,IENS,72,"E"))
S MTMFTEXT=$G(AGDAT(F,IENS,73,"E"))
S MTMTEXT=$G(AGDAT(F,IENS,74,"E"))
S MTMQUAL=$G(AGDAT(F,IENS,75,"E"))
S MTMCODE=$G(AGDAT(F,IENS,76,"E"))
S TOSEXP=$G(AGDAT(F,IENS,77,"I")) I $G(TOSEXP) S TOSEXP=$P($$EXTIME^PSOERXO1(TOSEXP),"T")
S TOSEFF=$G(AGDAT(F,IENS,78,"I")) I $G(TOSEFF) S TOSEFF=$P($$EXTIME^PSOERXO1(TOSEFF),"T")
S TOSGRSET=$G(AGDAT(F,IENS,79,"E"))
I $L(AGNCNAME_TOSFT) D
.D C S @GBL@(CNT,0)="<Service>"
.D C S @GBL@(CNT,0)="<AgencyOfService>"
.D BL(GBL,.CNT,"BusinessName",AGNCNAME) ; filing issue
.;set gbl's
.D OADD^PSOERXOU(GBL,.CNT,AGNCADL1,AGNCADL2,AGNCCITY,AGNCST,AGNCPOST,AGNCCC)
.S SGBL=$NA(^PS(52.49,ERXIEN,311,MIEN,25))
.D OCOMM^PSOERXOU(GBL,SGBL,.CNT,MIEN_","_ERXIEN_",",52.4931125,52.49311,26,MIEN_","_ERXIEN_",")
.D ONAME^PSOERXOU(GBL,.CNT,"AgencyContactName",AGNCYLN,AGNCYFN,AGNCYMN,AGNCYSUF,AGNCYPRF)
.D C S @GBL@(CNT,0)="</AgencyOfService>"
I $L(TOSFT) D
.D C S @GBL@(CNT,0)="<ServiceType>"
D BL(GBL,.CNT,"TypeOfServiceFreeText",TOSFT)
I $L(TOST_TOSQUAL_TOSCODE) D
.D C S @GBL@(CNT,0)="<TypeOfService>"
.D BL(GBL,.CNT,"Text",TOST)
.D BL(GBL,.CNT,"Qualifier",TOSQUAL)
.D BL(GBL,.CNT,"Code",TOSCODE)
.D C S @GBL@(CNT,0)="</TypeOfService>"
D BL(GBL,.CNT,"TargetedTypeOfServiceFreeText",TARGFT)
I $L(TARGT_TARGQUAL_TARGCODE) D
.D C S @GBL@(CNT,0)="<TargetedTypeOfService>"
.D BL(GBL,.CNT,"Text",TARGT)
.D BL(GBL,.CNT,"Qualifier",TARGQUAL)
.D BL(GBL,.CNT,"Code",TARGCODE)
.D C S @GBL@(CNT,0)="</TargetedTypeOfService>"
I $L(TOSEFF) D
.D C S @GBL@(CNT,0)="<EffectiveDate>"
.D BL(GBL,.CNT,"Date",TOSEFF)
.D C S @GBL@(CNT,0)="</EffectiveDate>"
I $L(TOSEXP) D
.D C S @GBL@(CNT,0)="<ExpirationDate>"
.D BL(GBL,.CNT,"Date",TOSEXP)
.D C S @GBL@(CNT,0)="</ExpirationDate>"
D BL(GBL,.CNT,"ReasonForMTMServiceFreeText",MTMFTEXT)
I $L(MTMTEXT_MTMQUAL_MTMCODE) D
.D C S @GBL@(CNT,0)="<ReasonForMTMService>"
.D BL(GBL,.CNT,"Text",MTMTEXT)
.D BL(GBL,.CNT,"Qualifier",MTMQUAL)
.D BL(GBL,.CNT,"Code",MTMCODE)
.D C S @GBL@(CNT,0)="</ReasonForMTMService>"
D BL(GBL,.CNT,"TypeOfServiceGroupSetting",TOSGRSET)
I $L(AGNCNAME_TOSFT) D
.D C S @GBL@(CNT,0)="</ServiceType>"
.D C S @GBL@(CNT,0)="</Service>"
;FINISH OUTBOUND
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[HPSOERXOL 8193 printed Sep 23, 2025@20:05:21 Page 2
PSOERXOL ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
+1 ;;7.0;OUTPATIENT PHARMACY;**581**;DEC 1997;Build 126
+2 ;
+3 QUIT
OOPHAFF(GL,CNT,ERXIEN,MIEN) ;outbound office of pharmacy affairs segment
+1 NEW F,PAIEN,PADAT,PAIENS,PAID
+2 SET F=52.4931117
+3 SET PAIEN=0
FOR
SET PAIEN=$ORDER(^PS(52.49,ERXIEN,311,MIEN,17,PAIEN))
if 'PAIEN
QUIT
Begin DoDot:1
+4 KILL PADAT
+5 SET PAIENS=PAIEN_","_MIEN_","_ERXIEN_","
+6 DO GETS^DIQ(F,PAIENS,"**","IE","PADAT")
+7 SET PAID=$GET(PADAT(F,PAIENS,.02,"E"))
+8 DO BL(GBL,.CNT,"OfficeOfPharmacyAffairsID",PAID)
End DoDot:1
+9 QUIT
OWOUND(GL,CNT,ERXIEN,MIEN) ;outbound wound segment
+1 NEW WIEN,WDAT,WIENS,LOCCODE,LOCTEXT,LATCODE,LATTEXT,LENGTH,WIDTH,DEPTH
+2 IF '$ORDER(^PS(52.49,ERXIEN,311,MIEN,46,0))
QUIT
+3 SET F=52.4931146
+4 SET WIEN=0
FOR
SET WIEN=$ORDER(^PS(52.49,ERXIEN,311,MIEN,46,WIEN))
if 'WIEN
QUIT
Begin DoDot:1
+5 KILL WDAT
+6 SET WIENS=WIEN_","_MIEN_","_ERXIEN_","
+7 DO GETS^DIQ(F,WIENS,"**","IE","WDAT")
+8 SET LOCCODE=$GET(WDAT(F,WIENS,.02,"E"))
+9 SET LOCTEXT=$GET(WDAT(F,WIENS,1,"E"))
+10 SET LATCODE=$GET(WDAT(F,WIENS,2.1,"I"))
+11 SET LATTEXT=$GET(WDAT(F,WIENS,3,"E"))
+12 SET LENGTH=$GET(WDAT(F,WIENS,4.1,"E"))
+13 SET WIDTH=$GET(WDAT(F,WIENS,4.2,"E"))
+14 SET DEPTH=$GET(WDAT(F,WIENS,4.3,"E"))
+15 DO C
SET @GBL@(CNT,0)="<Wound>"
+16 DO C
SET @GBL@(CNT,0)="<Location>"
+17 DO BL(GBL,.CNT,"Text",LOCTEXT)
+18 DO BL(GBL,.CNT,"Code",LOCCODE)
+19 DO C
SET @GBL@(CNT,0)="</Location>"
+20 DO C
SET @GBL@(CNT,0)="<Laterality>"
+21 DO BL(GBL,.CNT,"Text",LATTEXT)
+22 DO BL(GBL,.CNT,"Code",LATCODE)
+23 DO C
SET @GBL@(CNT,0)="</Laterality>"
+24 DO BL(GBL,.CNT,"Length",LENGTH)
+25 DO BL(GBL,.CNT,"Width",WIDTH)
+26 DO BL(GBL,.CNT,"Depth",DEPTH)
+27 DO C
SET @GBL@(CNT,0)="</Wound>"
End DoDot:1
+28 QUIT
OIVA(GBL,CNT,ERXIEN,MIEN) ; outbound IV administration segment
+1 NEW NUMLUMEN,DILQTY,DILQUAL,DILQUOM,ADMINGAU,ADMINBR,ADMINLEN,ADMINPMP,TYPECODE,TYPETEXT,DEVDESC,DEVCODE,DEVTEXT,TIPCODE,TIPTEXT
+2 NEW TIPDESC,INFUCODE,INFUTEXT,INFUDESC,IENS,IVDAT
+3 SET F=52.49311
+4 SET IENS=MIEN_","_ERXIEN_","
+5 DO GETS^DIQ(F,IENS,"**","IE","IVDAT")
+6 SET NUMLUMEN=$GET(IVDAT(F,IENS,28,"E"))
+7 SET DILQTY=$GET(IVDAT(F,IENS,29.1,"E"))
+8 SET DILQUAL=$GET(IVDAT(F,IENS,29.2,"E"))
+9 SET DILQUOM=$GET(IVDAT(F,IENS,29.3,"E"))
+10 SET ADMINGAU=$GET(IVDAT(F,IENS,30,"E"))
+11 SET ADMINBR=$GET(IVDAT(F,IENS,31,"E"))
+12 SET ADMINLEN=$GET(IVDAT(F,IENS,32,"E"))
+13 SET ADMINPMP=$GET(IVDAT(F,IENS,33.1,"I"))
+14 SET TYPECODE=$GET(IVDAT(F,IENS,34.1,"E"))
+15 SET TYPETEXT=$GET(IVDAT(F,IENS,35,"E"))
+16 SET DEVDESC=$GET(IVDAT(F,IENS,36,"E"))
+17 SET DEVCODE=$GET(IVDAT(F,IENS,37.1,"E"))
+18 SET DEVTEXT=$GET(IVDAT(F,IENS,38,"E"))
+19 SET TIPCODE=$GET(IVDAT(F,IENS,39.1,"E"))
+20 SET TIPTEXT=$GET(IVDAT(F,IENS,40,"E"))
+21 SET TIPDESC=$GET(IVDAT(F,IENS,41,"E"))
+22 SET INFUCODE=$GET(IVDAT(F,IENS,42.1,"E"))
+23 SET INFUTEXT=$GET(IVDAT(F,IENS,43,"E"))
+24 SET INFUDESC=$GET(IVDAT(F,IENS,44,"E"))
+25 IF $LENGTH(TYPETEXT)
Begin DoDot:1
+26 DO C
SET @GBL@(CNT,0)="<IVAdministration>"
End DoDot:1
+27 DO BL(GBL,.CNT,"NumberOfLumens",NUMLUMEN)
+28 IF $LENGTH(DILQTY_DILQUAL_DILQUOM)
Begin DoDot:1
+29 DO C
SET @GBL@(CNT,0)="<DiluentAmount>"
+30 DO BL(GBL,.CNT,"Value",DILQTY)
+31 DO BL(GBL,.CNT,"CodeListQualifier",DILQUAL)
+32 IF $LENGTH(DILQUOM)
Begin DoDot:2
+33 DO C
SET @GBL@(CNT,0)="<QuantityUnitOfMeasure>"
+34 DO BL(GBL,.CNT,"Code",DILQUOM)
+35 DO C
SET @GBL@(CNT,0)="</QuantityUnitOfMeasure>"
End DoDot:2
+36 DO C
SET @GBL@(CNT,0)="</DiluentAmount>"
End DoDot:1
+37 DO BL(GBL,.CNT,"SpecificAdministrationGauge",ADMINGAU)
+38 DO BL(GBL,.CNT,"SpecificAdministrationBrand",ADMINBR)
+39 DO BL(GBL,.CNT,"SpecificAdministrationLength",ADMINLEN)
+40 DO BL(GBL,.CNT,"SpecificAdministrationPump",ADMINPMP)
+41 IF $LENGTH(TYPETEXT_TYPECODE)
Begin DoDot:1
+42 DO C
SET @GBL@(CNT,0)="<IVAccessType>"
+43 DO BL(GBL,.CNT,"Text",TYPETEXT)
+44 DO BL(GBL,.CNT,"Code",TYPECODE)
+45 DO C
SET @GBL@(CNT,0)="</IVAccessType>"
End DoDot:1
+46 IF $LENGTH(DEVTEXT_DEVCODE_DEVDESC)
Begin DoDot:1
+47 DO C
SET @GBL@(CNT,0)="<IVAccessDeviceType>"
+48 DO BL(GBL,.CNT,"IVAccessDeviceTypeDescription",DEVDESC)
+49 DO C
SET @GBL@(CNT,0)="<IVAccessDeviceType>"
+50 DO BL(GBL,.CNT,"Text",DEVTEXT)
+51 DO BL(GBL,.CNT,"Code",DEVCODE)
+52 DO C
SET @GBL@(CNT,0)="</IVAccessDeviceType>"
+53 DO C
SET @GBL@(CNT,0)="</IVAccessDeviceType>"
End DoDot:1
+54 IF $LENGTH(TIPDESC_TIPTEXT_TIPCODE)
Begin DoDot:1
+55 DO C
SET @GBL@(CNT,0)="<IVAccessCatheterTip>"
+56 DO BL(GBL,.CNT,"IVAccessCatheterTipDescription",TIPDESC)
End DoDot:1
+57 IF $LENGTH(TIPTEXT_TIPCODE)
Begin DoDot:1
+58 DO C
SET @GBL@(CNT,0)="<IVAccessCatheterTipType>"
+59 DO BL(GBL,.CNT,"Text",TIPTEXT)
+60 DO BL(GBL,.CNT,"Code",TIPCODE)
+61 DO C
SET @GBL@(CNT,0)="</IVAccessCatheterTipType>"
+62 DO C
SET @GBL@(CNT,0)="</IVAccessCatheterTip>"
End DoDot:1
+63 IF $LENGTH(INFUDESC_INFUTEXT_INFUCODE)
Begin DoDot:1
+64 DO C
SET @GBL@(CNT,0)="<IVInfusion>"
+65 DO BL(GBL,.CNT,"IVInfusionDescription",INFUDESC)
End DoDot:1
+66 IF $LENGTH(INFUTEXT_INFUCODE)
Begin DoDot:1
+67 DO C
SET @GBL@(CNT,0)="<IVInfusionType>"
+68 DO BL(GBL,.CNT,"Text",INFUTEXT)
+69 DO BL(GBL,.CNT,"Code",INFUCODE)
+70 DO C
SET @GBL@(CNT,0)="</IVInfusionType>"
+71 DO C
SET @GBL@(CNT,0)="</IVInfusion>"
End DoDot:1
+72 IF $LENGTH(TYPETEXT)
Begin DoDot:1
+73 DO C
SET @GBL@(CNT,0)="</IVAdministration>"
End DoDot:1
+74 QUIT
OAGENCY(GBL,CNT,ERXIEN,MIEN) ;
+1 NEW AGNCNAME,AGNCADL1,AGNCADL2,AGNCCITY,AGNCST,AGNCPOST,AGNCCC,AGNCYLN,AGNCYFN,AGNCYMN,AGNCYSUF,AGNCYSUF
+2 NEW TOSFT,TOST,TOSQUAL,TOSCODE,TARGFT,TARGT,TARGQUAL,TARGCODE,MTMFTEXT,MTMTEXT,MTMQUAL,MTMCODE,MTMCODE,TOSEXP,TOSEFF,TOSGRSET
+3 NEW AGDAT,AGNCYPRF,SGBL
+4 SET F=52.49311
+5 SET IENS=MIEN_","_ERXIEN_","
+6 DO GETS^DIQ(F,IENS,"21.1;21.2;21.3;21.4;21.5;21.6;21.7;27.1;27.2;27.3;27.4;27.5;64;65;66;67;68;69;71;72;73;74;75;76;77;78;79;81","IE","AGDAT")
+7 SET AGNCNAME=$GET(AGDAT(F,IENS,21.1,"E"))
+8 SET AGNCADL1=$GET(AGDAT(F,IENS,21.2,"E"))
+9 SET AGNCADL2=$GET(AGDAT(F,IENS,21.3,"E"))
+10 SET AGNCCITY=$GET(AGDAT(F,IENS,21.4,"E"))
+11 SET AGNCST=$GET(AGDAT(F,IENS,21.5,"I"))
+12 SET AGNCPOST=$GET(AGDAT(F,IENS,21.6,"E"))
+13 SET AGNCCC=$GET(AGDAT(F,IENS,21.7,"E"))
+14 SET AGNCYLN=$GET(AGDAT(F,IENS,27.1,"E"))
+15 SET AGNCYFN=$GET(AGDAT(F,IENS,27.2,"E"))
+16 SET AGNCYMN=$GET(AGDAT(F,IENS,27.3,"E"))
+17 SET AGNCYSUF=$GET(AGDAT(F,IENS,27.4,"E"))
+18 SET AGNCYPRF=$GET(AGDAT(F,IENS,27.5,"E"))
+19 SET TOSFT=$GET(AGDAT(F,IENS,64,"E"))
+20 SET TOST=$GET(AGDAT(F,IENS,65,"E"))
+21 SET TOSQUAL=$GET(AGDAT(F,IENS,66,"E"))
+22 SET TOSCODE=$GET(AGDAT(F,IENS,67,"E"))
+23 SET TARGFT=$GET(AGDAT(F,IENS,68,"E"))
+24 SET TARGT=$GET(AGDAT(F,IENS,69,"E"))
+25 SET TARGQUAL=$GET(AGDAT(F,IENS,71,"E"))
+26 SET TARGCODE=$GET(AGDAT(F,IENS,72,"E"))
+27 SET MTMFTEXT=$GET(AGDAT(F,IENS,73,"E"))
+28 SET MTMTEXT=$GET(AGDAT(F,IENS,74,"E"))
+29 SET MTMQUAL=$GET(AGDAT(F,IENS,75,"E"))
+30 SET MTMCODE=$GET(AGDAT(F,IENS,76,"E"))
+31 SET TOSEXP=$GET(AGDAT(F,IENS,77,"I"))
IF $GET(TOSEXP)
SET TOSEXP=$PIECE($$EXTIME^PSOERXO1(TOSEXP),"T")
+32 SET TOSEFF=$GET(AGDAT(F,IENS,78,"I"))
IF $GET(TOSEFF)
SET TOSEFF=$PIECE($$EXTIME^PSOERXO1(TOSEFF),"T")
+33 SET TOSGRSET=$GET(AGDAT(F,IENS,79,"E"))
+34 IF $LENGTH(AGNCNAME_TOSFT)
Begin DoDot:1
+35 DO C
SET @GBL@(CNT,0)="<Service>"
+36 DO C
SET @GBL@(CNT,0)="<AgencyOfService>"
+37 ; filing issue
DO BL(GBL,.CNT,"BusinessName",AGNCNAME)
+38 ;set gbl's
+39 DO OADD^PSOERXOU(GBL,.CNT,AGNCADL1,AGNCADL2,AGNCCITY,AGNCST,AGNCPOST,AGNCCC)
+40 SET SGBL=$NAME(^PS(52.49,ERXIEN,311,MIEN,25))
+41 DO OCOMM^PSOERXOU(GBL,SGBL,.CNT,MIEN_","_ERXIEN_",",52.4931125,52.49311,26,MIEN_","_ERXIEN_",")
+42 DO ONAME^PSOERXOU(GBL,.CNT,"AgencyContactName",AGNCYLN,AGNCYFN,AGNCYMN,AGNCYSUF,AGNCYPRF)
+43 DO C
SET @GBL@(CNT,0)="</AgencyOfService>"
End DoDot:1
+44 IF $LENGTH(TOSFT)
Begin DoDot:1
+45 DO C
SET @GBL@(CNT,0)="<ServiceType>"
End DoDot:1
+46 DO BL(GBL,.CNT,"TypeOfServiceFreeText",TOSFT)
+47 IF $LENGTH(TOST_TOSQUAL_TOSCODE)
Begin DoDot:1
+48 DO C
SET @GBL@(CNT,0)="<TypeOfService>"
+49 DO BL(GBL,.CNT,"Text",TOST)
+50 DO BL(GBL,.CNT,"Qualifier",TOSQUAL)
+51 DO BL(GBL,.CNT,"Code",TOSCODE)
+52 DO C
SET @GBL@(CNT,0)="</TypeOfService>"
End DoDot:1
+53 DO BL(GBL,.CNT,"TargetedTypeOfServiceFreeText",TARGFT)
+54 IF $LENGTH(TARGT_TARGQUAL_TARGCODE)
Begin DoDot:1
+55 DO C
SET @GBL@(CNT,0)="<TargetedTypeOfService>"
+56 DO BL(GBL,.CNT,"Text",TARGT)
+57 DO BL(GBL,.CNT,"Qualifier",TARGQUAL)
+58 DO BL(GBL,.CNT,"Code",TARGCODE)
+59 DO C
SET @GBL@(CNT,0)="</TargetedTypeOfService>"
End DoDot:1
+60 IF $LENGTH(TOSEFF)
Begin DoDot:1
+61 DO C
SET @GBL@(CNT,0)="<EffectiveDate>"
+62 DO BL(GBL,.CNT,"Date",TOSEFF)
+63 DO C
SET @GBL@(CNT,0)="</EffectiveDate>"
End DoDot:1
+64 IF $LENGTH(TOSEXP)
Begin DoDot:1
+65 DO C
SET @GBL@(CNT,0)="<ExpirationDate>"
+66 DO BL(GBL,.CNT,"Date",TOSEXP)
+67 DO C
SET @GBL@(CNT,0)="</ExpirationDate>"
End DoDot:1
+68 DO BL(GBL,.CNT,"ReasonForMTMServiceFreeText",MTMFTEXT)
+69 IF $LENGTH(MTMTEXT_MTMQUAL_MTMCODE)
Begin DoDot:1
+70 DO C
SET @GBL@(CNT,0)="<ReasonForMTMService>"
+71 DO BL(GBL,.CNT,"Text",MTMTEXT)
+72 DO BL(GBL,.CNT,"Qualifier",MTMQUAL)
+73 DO BL(GBL,.CNT,"Code",MTMCODE)
+74 DO C
SET @GBL@(CNT,0)="</ReasonForMTMService>"
End DoDot:1
+75 DO BL(GBL,.CNT,"TypeOfServiceGroupSetting",TOSGRSET)
+76 IF $LENGTH(AGNCNAME_TOSFT)
Begin DoDot:1
+77 DO C
SET @GBL@(CNT,0)="</ServiceType>"
+78 DO C
SET @GBL@(CNT,0)="</Service>"
End DoDot:1
+79 ;FINISH OUTBOUND
+80 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
