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. 
  1. PSOERXOL ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
  1.  ;;7.0;OUTPATIENT PHARMACY;**581**;DEC 1997;Build 126
  1.  ;
  1.  Q
  1. OOPHAFF(GL,CNT,ERXIEN,MIEN) ;outbound office of pharmacy affairs segment
  1.  N F,PAIEN,PADAT,PAIENS,PAID
  1.  S F=52.4931117
  1.  S PAIEN=0 F  S PAIEN=$O(^PS(52.49,ERXIEN,311,MIEN,17,PAIEN)) Q:'PAIEN  D
  1.  .K PADAT
  1.  .S PAIENS=PAIEN_","_MIEN_","_ERXIEN_","
  1.  .D GETS^DIQ(F,PAIENS,"**","IE","PADAT")
  1.  .S PAID=$G(PADAT(F,PAIENS,.02,"E"))
  1.  .D BL(GBL,.CNT,"OfficeOfPharmacyAffairsID",PAID)
  1.  Q
  1. OWOUND(GL,CNT,ERXIEN,MIEN) ;outbound wound segment
  1.  N WIEN,WDAT,WIENS,LOCCODE,LOCTEXT,LATCODE,LATTEXT,LENGTH,WIDTH,DEPTH
  1.  I '$O(^PS(52.49,ERXIEN,311,MIEN,46,0)) Q
  1.  S F=52.4931146
  1.  S WIEN=0 F  S WIEN=$O(^PS(52.49,ERXIEN,311,MIEN,46,WIEN)) Q:'WIEN  D
  1.  .K WDAT
  1.  .S WIENS=WIEN_","_MIEN_","_ERXIEN_","
  1.  .D GETS^DIQ(F,WIENS,"**","IE","WDAT")
  1.  .S LOCCODE=$G(WDAT(F,WIENS,.02,"E"))
  1.  .S LOCTEXT=$G(WDAT(F,WIENS,1,"E"))
  1.  .S LATCODE=$G(WDAT(F,WIENS,2.1,"I"))
  1.  .S LATTEXT=$G(WDAT(F,WIENS,3,"E"))
  1.  .S LENGTH=$G(WDAT(F,WIENS,4.1,"E"))
  1.  .S WIDTH=$G(WDAT(F,WIENS,4.2,"E"))
  1.  .S DEPTH=$G(WDAT(F,WIENS,4.3,"E"))
  1.  .D C S @GBL@(CNT,0)="<Wound>"
  1.  .D C S @GBL@(CNT,0)="<Location>"
  1.  .D BL(GBL,.CNT,"Text",LOCTEXT)
  1.  .D BL(GBL,.CNT,"Code",LOCCODE)
  1.  .D C S @GBL@(CNT,0)="</Location>"
  1.  .D C S @GBL@(CNT,0)="<Laterality>"
  1.  .D BL(GBL,.CNT,"Text",LATTEXT)
  1.  .D BL(GBL,.CNT,"Code",LATCODE)
  1.  .D C S @GBL@(CNT,0)="</Laterality>"
  1.  .D BL(GBL,.CNT,"Length",LENGTH)
  1.  .D BL(GBL,.CNT,"Width",WIDTH)
  1.  .D BL(GBL,.CNT,"Depth",DEPTH)
  1.  .D C S @GBL@(CNT,0)="</Wound>"
  1.  Q
  1. OIVA(GBL,CNT,ERXIEN,MIEN) ; outbound IV administration segment
  1.  N NUMLUMEN,DILQTY,DILQUAL,DILQUOM,ADMINGAU,ADMINBR,ADMINLEN,ADMINPMP,TYPECODE,TYPETEXT,DEVDESC,DEVCODE,DEVTEXT,TIPCODE,TIPTEXT
  1.  N TIPDESC,INFUCODE,INFUTEXT,INFUDESC,IENS,IVDAT
  1.  S F=52.49311
  1.  S IENS=MIEN_","_ERXIEN_","
  1.  D GETS^DIQ(F,IENS,"**","IE","IVDAT")
  1.  S NUMLUMEN=$G(IVDAT(F,IENS,28,"E"))
  1.  S DILQTY=$G(IVDAT(F,IENS,29.1,"E"))
  1.  S DILQUAL=$G(IVDAT(F,IENS,29.2,"E"))
  1.  S DILQUOM=$G(IVDAT(F,IENS,29.3,"E"))
  1.  S ADMINGAU=$G(IVDAT(F,IENS,30,"E"))
  1.  S ADMINBR=$G(IVDAT(F,IENS,31,"E"))
  1.  S ADMINLEN=$G(IVDAT(F,IENS,32,"E"))
  1.  S ADMINPMP=$G(IVDAT(F,IENS,33.1,"I"))
  1.  S TYPECODE=$G(IVDAT(F,IENS,34.1,"E"))
  1.  S TYPETEXT=$G(IVDAT(F,IENS,35,"E"))
  1.  S DEVDESC=$G(IVDAT(F,IENS,36,"E"))
  1.  S DEVCODE=$G(IVDAT(F,IENS,37.1,"E"))
  1.  S DEVTEXT=$G(IVDAT(F,IENS,38,"E"))
  1.  S TIPCODE=$G(IVDAT(F,IENS,39.1,"E"))
  1.  S TIPTEXT=$G(IVDAT(F,IENS,40,"E"))
  1.  S TIPDESC=$G(IVDAT(F,IENS,41,"E"))
  1.  S INFUCODE=$G(IVDAT(F,IENS,42.1,"E"))
  1.  S INFUTEXT=$G(IVDAT(F,IENS,43,"E"))
  1.  S INFUDESC=$G(IVDAT(F,IENS,44,"E"))
  1.  I $L(TYPETEXT) D
  1.  .D C S @GBL@(CNT,0)="<IVAdministration>"
  1.  D BL(GBL,.CNT,"NumberOfLumens",NUMLUMEN)
  1.  I $L(DILQTY_DILQUAL_DILQUOM) D
  1.  .D C S @GBL@(CNT,0)="<DiluentAmount>"
  1.  .D BL(GBL,.CNT,"Value",DILQTY)
  1.  .D BL(GBL,.CNT,"CodeListQualifier",DILQUAL)
  1.  .I $L(DILQUOM) D
  1.  ..D C S @GBL@(CNT,0)="<QuantityUnitOfMeasure>"
  1.  ..D BL(GBL,.CNT,"Code",DILQUOM)
  1.  ..D C S @GBL@(CNT,0)="</QuantityUnitOfMeasure>"
  1.  .D C S @GBL@(CNT,0)="</DiluentAmount>"
  1.  D BL(GBL,.CNT,"SpecificAdministrationGauge",ADMINGAU)
  1.  D BL(GBL,.CNT,"SpecificAdministrationBrand",ADMINBR)
  1.  D BL(GBL,.CNT,"SpecificAdministrationLength",ADMINLEN)
  1.  D BL(GBL,.CNT,"SpecificAdministrationPump",ADMINPMP)
  1.  I $L(TYPETEXT_TYPECODE) D
  1.  .D C S @GBL@(CNT,0)="<IVAccessType>"
  1.  .D BL(GBL,.CNT,"Text",TYPETEXT)
  1.  .D BL(GBL,.CNT,"Code",TYPECODE)
  1.  .D C S @GBL@(CNT,0)="</IVAccessType>"
  1.  I $L(DEVTEXT_DEVCODE_DEVDESC) D
  1.  .D C S @GBL@(CNT,0)="<IVAccessDeviceType>"
  1.  .D BL(GBL,.CNT,"IVAccessDeviceTypeDescription",DEVDESC)
  1.  .D C S @GBL@(CNT,0)="<IVAccessDeviceType>"
  1.  .D BL(GBL,.CNT,"Text",DEVTEXT)
  1.  .D BL(GBL,.CNT,"Code",DEVCODE)
  1.  .D C S @GBL@(CNT,0)="</IVAccessDeviceType>"
  1.  .D C S @GBL@(CNT,0)="</IVAccessDeviceType>"
  1.  I $L(TIPDESC_TIPTEXT_TIPCODE) D
  1.  .D C S @GBL@(CNT,0)="<IVAccessCatheterTip>"
  1.  .D BL(GBL,.CNT,"IVAccessCatheterTipDescription",TIPDESC)
  1.  I $L(TIPTEXT_TIPCODE) D
  1.  .D C S @GBL@(CNT,0)="<IVAccessCatheterTipType>"
  1.  .D BL(GBL,.CNT,"Text",TIPTEXT)
  1.  .D BL(GBL,.CNT,"Code",TIPCODE)
  1.  .D C S @GBL@(CNT,0)="</IVAccessCatheterTipType>"
  1.  .D C S @GBL@(CNT,0)="</IVAccessCatheterTip>"
  1.  I $L(INFUDESC_INFUTEXT_INFUCODE) D
  1.  .D C S @GBL@(CNT,0)="<IVInfusion>"
  1.  .D BL(GBL,.CNT,"IVInfusionDescription",INFUDESC)
  1.  I $L(INFUTEXT_INFUCODE) D
  1.  .D C S @GBL@(CNT,0)="<IVInfusionType>"
  1.  .D BL(GBL,.CNT,"Text",INFUTEXT)
  1.  .D BL(GBL,.CNT,"Code",INFUCODE)
  1.  .D C S @GBL@(CNT,0)="</IVInfusionType>"
  1.  .D C S @GBL@(CNT,0)="</IVInfusion>"
  1.  I $L(TYPETEXT) D
  1.  .D C S @GBL@(CNT,0)="</IVAdministration>"
  1.  Q
  1. OAGENCY(GBL,CNT,ERXIEN,MIEN) ;
  1.  N AGNCNAME,AGNCADL1,AGNCADL2,AGNCCITY,AGNCST,AGNCPOST,AGNCCC,AGNCYLN,AGNCYFN,AGNCYMN,AGNCYSUF,AGNCYSUF
  1.  N TOSFT,TOST,TOSQUAL,TOSCODE,TARGFT,TARGT,TARGQUAL,TARGCODE,MTMFTEXT,MTMTEXT,MTMQUAL,MTMCODE,MTMCODE,TOSEXP,TOSEFF,TOSGRSET
  1.  N AGDAT,AGNCYPRF,SGBL
  1.  S F=52.49311
  1.  S IENS=MIEN_","_ERXIEN_","
  1.  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")
  1.  S AGNCNAME=$G(AGDAT(F,IENS,21.1,"E"))
  1.  S AGNCADL1=$G(AGDAT(F,IENS,21.2,"E"))
  1.  S AGNCADL2=$G(AGDAT(F,IENS,21.3,"E"))
  1.  S AGNCCITY=$G(AGDAT(F,IENS,21.4,"E"))
  1.  S AGNCST=$G(AGDAT(F,IENS,21.5,"I"))
  1.  S AGNCPOST=$G(AGDAT(F,IENS,21.6,"E"))
  1.  S AGNCCC=$G(AGDAT(F,IENS,21.7,"E"))
  1.  S AGNCYLN=$G(AGDAT(F,IENS,27.1,"E"))
  1.  S AGNCYFN=$G(AGDAT(F,IENS,27.2,"E"))
  1.  S AGNCYMN=$G(AGDAT(F,IENS,27.3,"E"))
  1.  S AGNCYSUF=$G(AGDAT(F,IENS,27.4,"E"))
  1.  S AGNCYPRF=$G(AGDAT(F,IENS,27.5,"E"))
  1.  S TOSFT=$G(AGDAT(F,IENS,64,"E"))
  1.  S TOST=$G(AGDAT(F,IENS,65,"E"))
  1.  S TOSQUAL=$G(AGDAT(F,IENS,66,"E"))
  1.  S TOSCODE=$G(AGDAT(F,IENS,67,"E"))
  1.  S TARGFT=$G(AGDAT(F,IENS,68,"E"))
  1.  S TARGT=$G(AGDAT(F,IENS,69,"E"))
  1.  S TARGQUAL=$G(AGDAT(F,IENS,71,"E"))
  1.  S TARGCODE=$G(AGDAT(F,IENS,72,"E"))
  1.  S MTMFTEXT=$G(AGDAT(F,IENS,73,"E"))
  1.  S MTMTEXT=$G(AGDAT(F,IENS,74,"E"))
  1.  S MTMQUAL=$G(AGDAT(F,IENS,75,"E"))
  1.  S MTMCODE=$G(AGDAT(F,IENS,76,"E"))
  1.  S TOSEXP=$G(AGDAT(F,IENS,77,"I")) I $G(TOSEXP) S TOSEXP=$P($$EXTIME^PSOERXO1(TOSEXP),"T")
  1.  S TOSEFF=$G(AGDAT(F,IENS,78,"I")) I $G(TOSEFF) S TOSEFF=$P($$EXTIME^PSOERXO1(TOSEFF),"T")
  1.  S TOSGRSET=$G(AGDAT(F,IENS,79,"E"))
  1.  I $L(AGNCNAME_TOSFT) D
  1.  .D C S @GBL@(CNT,0)="<Service>"
  1.  .D C S @GBL@(CNT,0)="<AgencyOfService>"
  1.  .D BL(GBL,.CNT,"BusinessName",AGNCNAME) ; filing issue
  1.  .;set gbl's
  1.  .D OADD^PSOERXOU(GBL,.CNT,AGNCADL1,AGNCADL2,AGNCCITY,AGNCST,AGNCPOST,AGNCCC)
  1.  .S SGBL=$NA(^PS(52.49,ERXIEN,311,MIEN,25))
  1.  .D OCOMM^PSOERXOU(GBL,SGBL,.CNT,MIEN_","_ERXIEN_",",52.4931125,52.49311,26,MIEN_","_ERXIEN_",")
  1.  .D ONAME^PSOERXOU(GBL,.CNT,"AgencyContactName",AGNCYLN,AGNCYFN,AGNCYMN,AGNCYSUF,AGNCYPRF)
  1.  .D C S @GBL@(CNT,0)="</AgencyOfService>"
  1.  I $L(TOSFT) D
  1.  .D C S @GBL@(CNT,0)="<ServiceType>"
  1.  D BL(GBL,.CNT,"TypeOfServiceFreeText",TOSFT)
  1.  I $L(TOST_TOSQUAL_TOSCODE) D
  1.  .D C S @GBL@(CNT,0)="<TypeOfService>"
  1.  .D BL(GBL,.CNT,"Text",TOST)
  1.  .D BL(GBL,.CNT,"Qualifier",TOSQUAL)
  1.  .D BL(GBL,.CNT,"Code",TOSCODE)
  1.  .D C S @GBL@(CNT,0)="</TypeOfService>"
  1.  D BL(GBL,.CNT,"TargetedTypeOfServiceFreeText",TARGFT)
  1.  I $L(TARGT_TARGQUAL_TARGCODE) D
  1.  .D C S @GBL@(CNT,0)="<TargetedTypeOfService>"
  1.  .D BL(GBL,.CNT,"Text",TARGT)
  1.  .D BL(GBL,.CNT,"Qualifier",TARGQUAL)
  1.  .D BL(GBL,.CNT,"Code",TARGCODE)
  1.  .D C S @GBL@(CNT,0)="</TargetedTypeOfService>"
  1.  I $L(TOSEFF) D
  1.  .D C S @GBL@(CNT,0)="<EffectiveDate>"
  1.  .D BL(GBL,.CNT,"Date",TOSEFF)
  1.  .D C S @GBL@(CNT,0)="</EffectiveDate>"
  1.  I $L(TOSEXP) D
  1.  .D C S @GBL@(CNT,0)="<ExpirationDate>"
  1.  .D BL(GBL,.CNT,"Date",TOSEXP)
  1.  .D C S @GBL@(CNT,0)="</ExpirationDate>"
  1.  D BL(GBL,.CNT,"ReasonForMTMServiceFreeText",MTMFTEXT)
  1.  I $L(MTMTEXT_MTMQUAL_MTMCODE) D
  1.  .D C S @GBL@(CNT,0)="<ReasonForMTMService>"
  1.  .D BL(GBL,.CNT,"Text",MTMTEXT)
  1.  .D BL(GBL,.CNT,"Qualifier",MTMQUAL)
  1.  .D BL(GBL,.CNT,"Code",MTMCODE)
  1.  .D C S @GBL@(CNT,0)="</ReasonForMTMService>"
  1.  D BL(GBL,.CNT,"TypeOfServiceGroupSetting",TOSGRSET)
  1.  I $L(AGNCNAME_TOSFT) D
  1.  .D C S @GBL@(CNT,0)="</ServiceType>"
  1.  .D C S @GBL@(CNT,0)="</Service>"
  1.  ;FINISH OUTBOUND
  1.  Q
  1. BL(GBL,CNT,TAG,VAR) ;
  1.  Q:VAR=""
  1.  D C S @GBL@(CNT,0)="<"_TAG_">"_$$SYMENC^MXMLUTL(VAR)_"</"_TAG_">"
  1.  Q
  1. C ;
  1.  S CNT=$G(CNT)+1
  1.  Q