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

PSOERXOL.m

Go to the documentation of this file.
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