PSOERXX3.m

PSOERXX3 ;ALB/BWF - eRx xml utilities ; 8/3/2016 5:14pm

 ;;7.0;OUTPATIENT PHARMACY;**467,508,551**;DEC 1997;Build 37

 ;

 Q

PATIENT(GBL,PSOISTE,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

 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"))

 ; DOB NEEDS TO BE CONVERTED

 S DOB=$G(PSDAT(F,PIENS,.08,"I")) I 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 STATE=$$STRES^PSOERXX2(STATE,PSOSITE)

 S ZIP=$G(PSDAT(F,PIENS,3.5,"E"))

 S PLQ=$G(PSDAT(F,PIENS,1.6,"E"))

 S PSSN=$G(PSDAT(F,PIENS,1.4,"E"))

 ; FUTURE ENHANCEMENT, GRAB CUNIT/BED/ROOM FROM CORRECT LOCATIONS. THIS LOGIC IS NOT ACTIVE WITH VERSION 2 

 S CUNIT=$G(PSDAT(F,PIENS,1,"E"))

 S BED=$G(PSDAT(F,PIENS,1,"E"))

 S ROOM=$G(PSDAT(F,PIENS,1,"E"))

 D C S @GBL@(CNT,0)="<Patient>"

 I $L(PATREL) D C S @GBL@(CNT,0)="<PatientRelationship>"_PATREL_"</PatientRelationship>"

 I '$O(^PS(52.46,PIEN,5,0)) D

 .I PSSN D

 ..D C S @GBL@(CNT,0)="<Identification>"

 ..D C S @GBL@(CNT,0)="<SocialSecurity>"_PSSN_"</SocialSecurity>"

 ..D C S @GBL@(CNT,0)="</Identification>"

 I $O(^PS(52.46,PIEN,5,0)) D

 .D C S @GBL@(CNT,0)="<Identification>"

 .S ILOOP=0 F  S ILOOP=$O(^PS(52.46,PIEN,5,ILOOP)) Q:'ILOOP  D

 ..S ITYP=$$GET1^DIQ(52.465,ILOOP_","_PIENS,.01,"E")

 ..S IVAL=$$GET1^DIQ(52.465,ILOOP_","_PIENS,.02,"E")

 ..D IDENT^PSOERXX2(.GBL,ITYP,IVAL)

 .D C S @GBL@(CNT,0)="</Identification>"

 D C S @GBL@(CNT,0)="<Name>"

 I $L(LNAME) D C S @GBL@(CNT,0)="<LastName>"_LNAME_"</LastName>"

 I $L(FNAME) D C S @GBL@(CNT,0)="<FirstName>"_FNAME_"</FirstName>"

 I $L(MNAME) D C S @GBL@(CNT,0)="<MiddleName>"_MNAME_"</MiddleName>"

 I $L(SUFF) D C S @GBL@(CNT,0)="<Suffix>"_SUFF_"</Suffix>"

 I $L(PREF) D C S @GBL@(CNT,0)="<Prefix>"_PREF_"</Prefix>"

 D C S @GBL@(CNT,0)="</Name>"

 I $L(GENDER) D C S @GBL@(CNT,0)="<Gender>"_GENDER_"</Gender>"

 I $L(DOB) D

 .D C S @GBL@(CNT,0)="<DateOfBirth>"

 .D C S @GBL@(CNT,0)="<Date>"_DOB_"</Date>"

 .D C S @GBL@(CNT,0)="</DateOfBirth>"

 I $L(ADDL1) D

 .D C S @GBL@(CNT,0)="<Address>"

 .I $L(ADDL1) D C S @GBL@(CNT,0)="<AddressLine1>"_ADDL1_"</AddressLine1>"

 .I $L(ADDL2) D C S @GBL@(CNT,0)="<AddressLine2>"_ADDL2_"</AddressLine2>"

 .I $L(CITY) D C S @GBL@(CNT,0)="<City>"_CITY_"</City>"

 .I $L(STATE) D C S @GBL@(CNT,0)="<State>"_STATE_"</State>"

 .I $L(ZIP) D C S @GBL@(CNT,0)="<ZipCode>"_ZIP_"</ZipCode>"

 .I $L(PLQ) D C S @GBL@(CNT,0)="<PlaceLocationQualifier>"_PLQ_"</PlaceLocationQualifier>"

 .D C S @GBL@(CNT,0)="</Address>"

 I $O(^PS(52.46,PIEN,3,0)) D

 .D C S @GBL@(CNT,0)="<CommunicationNumbers>"

 .S CLOOP=0 F  S CLOOP=$O(^PS(52.46,PIEN,3,CLOOP)) Q:'CLOOP  D

 ..S CNUM=$$GET1^DIQ(52.462,CLOOP_","_PIENS,.01,"E")

 ..S CQUAL=$$GET1^DIQ(52.462,CLOOP_","_PIENS,.02,"I")

 ..D COMMNUM^PSOERXX2(.GBL,CNUM,CQUAL)

 .D C S @GBL@(CNT,0)="</CommunicationNumbers>"

 I $L(CUNIT)!($L(BED))!($L(ROOM)) D

 .D C S @GBL@(CNT,0)="<PatientLocation>"

 .I $L(CUNIT) D C S @GBL@(CNT,0)="<FacilityUnit>"_CUNIT_"</FacilityUnit>"

 .I $L(BED) D C S @GBL@(CNT,0)="<Bed>"_BED_"</Bed>"

 .I $L(ROOM) D C S @GBL@(CNT,0)="<Room>"_ROOM_"</Room>"

 .D C S @GBL@(CNT,0)="</PatientLocation>"

 D C S @GBL@(CNT,0)="</Patient>"

 Q

FILLST(GBL,FTYPE,FNOTE) ;

 D C S @GBL@(CNT,0)="<FillStatus>"

 D C S @GBL@(CNT,0)=$S(FTYPE="F":"<Filled>",FTYPE="P":"<PartialFill>",1:"")

 D C S @GBL@(CNT,0)="<Note>"_FNOTE_"</Note>"

 D C S @GBL@(CNT,0)=$S(FTYPE="F":"</Filled>",FTYPE="P":"</PartialFill>",1:"")

 D C S @GBL@(CNT,0)="</FillStatus>"

 Q

BENEFITS(GBL,IEN) ;

 N F,NCPDPID,NCPDPID,PAYNAME,CARDID,LNAME,FNAME,MNAME,SUFF,PREF,GID,PSDAT,BIENS,BLOOP,IDLOOP

 S IENS=IEN_","

 S F=52.4918

 I '$O(^PS(52.49,IEN,18,0)) Q

 D C S @GBL@(CNT,0)="<BenefitsCoordination>"

 S BLOOP=0 F  S BLOOP=$O(^PS(52.49,IEN,18,BLOOP)) Q:'BLOOP  D

 .S BIENS=BLOOP_","_IENS

 .K PSDAT

 .D GETS^DIQ(F,BIENS,"**","IE","PSDAT")

 .D CONVXML^PSOERXX1("PSDAT")

 .; FUTURE ENHANCEMENT - the IDENTIFICATION multiple is where the NCPDPID info belongs, USE IDENTIFICATION MULTIPLE IN THE PAYER SUBFILE

 .;S NCPDPID=$G(PSDAT(F,IENS,1,"E"))

 .;FUTURE ENHANCEMENT - STORE PAYER NAME DIFFERENTLY AN..35

 .S PAYNAME=$E($G(PSDAT(F,BIENS,.03,"E")),1,35)

 .S CARDID=$G(PSDAT(F,BIENS,7,"E"))

 .S LNAME=$G(PSDAT(F,BIENS,1,"E"))

 .S FNAME=$G(PSDAT(F,BIENS,2,"E"))

 .S MNAME=$G(PSDAT(F,BIENS,3,"E"))

 .S SUFF=$G(PSDAT(F,BIENS,4,"E"))

 .S PREF=$G(PSDAT(F,BIENS,5,"E"))

 .S GID=$G(PSDAT(F,BIENS,.02,"E"))

 .; PAYER IDENTIFICATION INFORMATION

 .I $D(^PS(52.49,IEN,18,BLOOP,6)) D

 ..S IDLOOP=0 F  S IDLOOP=$O(^PS(52.49,IEN,18,BLOOP,6,IDLOOP)) Q:'IDLOOP  D

 ...D C S @GBL@(CNT,0)="<PayerIdentification>"

 ...S ITYP=$$GET1^DIQ(52.49186,IDLOOP_","_BLOOP_","_IENS,.01,"E")

 ...S IVAL=$$GET1^DIQ(52.49186,IDLOOP_","_BLOOP_","_IENS,.02,"E")

 ...D C S @GBL@(CNT,0)="<"_ITYP_">"_IVAL_"</"_ITYP_">"

 ...D C S @GBL@(CNT,0)="</PayerIdentification>"

 ..;D C S @GBL@(CNT,0)="</PayerIdentification>"

 .I $L(PAYNAME) D C S @GBL@(CNT,0)="<PayerName>"_PAYNAME_"</PayerName>"

 .I $L(CARDID) D C S @GBL@(CNT,0)="<CardholderID>"_CARDID_"</CardholderID>"

 .I ($L(LNAME))!($L(FNAME))!($L(MNAME))!($L(SUFF))!($L(PREF)) D

 ..D C S @GBL@(CNT,0)="<CardHolderName>"

 ..;/BLB/ - PSO*7*551 BEGIN CHANGE - PREVENT EMPTY SECTIONS

 ..I $L(LNAME) D C S @GBL@(CNT,0)="<LastName>"_LNAME_"</LastName>"

 ..I $L(FNAME) D C S @GBL@(CNT,0)="<FirstName>"_FNAME_"</FirstName>"

 ..I $L(MNAME) D C S @GBL@(CNT,0)="<MiddleName>"_MNAME_"</MiddleName>"

 ..I $L(SUFF) D C S @GBL@(CNT,0)="<Suffix>"_SUFF_"</Suffix>"

 ..I $L(PREF) D C S @GBL@(CNT,0)="<Prefix>"_PREF_"</Prefix>"

 ..D C S @GBL@(CNT,0)="</CardHolderName>"

 .I $L(GID) D C S @GBL@(CNT,0)="<GroupID>"_GID_"</GroupID>"

 D C S @GBL@(CNT,0)="</BenefitsCoordination>"

 Q

 ;/BLB/ PSO*7.0*551 - END CHANGE

OBSERVE(GBL,IEN) ;

 N F,DIMENS,VALUE,OBDATE,MDQ,MSC,MUC,OBNOTE,PSDAT,OIENS,OLOOP

 S F=52.4914

 S OBNOTE=$$GET1^DIQ(52.49,IEN,15,"E") S OBNOTE=$$SYMENC^MXMLUTL(OBNOTE)

 S IENS=IEN_","

 I '$O(^PS(52.49,IEN,14,0)) Q

 D C S @GBL@(CNT,0)="<Observation>"

 S OLOOP=0 F  S OLOOP=$O(^PS(52.49,IEN,14,OLOOP)) Q:'OLOOP  D

 .S OIENS=OLOOP_","_IENS

 .K PSDAT

 .D GETS^DIQ(F,OIENS,"**","IE","PSDAT")

 .D CONVXML^PSOERXX1("PSDAT")

 .S DIMENS=$G(PSDAT(F,OIENS,.02,"E"))

 .S VALUE=$G(PSDAT(F,OIENS,.03,"E"))

 .; convert observation date

 .S OBDATE=$G(PSDAT(F,OIENS,.04,"I")) I OBDATE S OBDATE=$P($$EXTIME^PSOERXO1(OBDATE),"T")

 .S MDQ=$G(PSDAT(F,OIENS,.05,"I"))

 .S MSC=$G(PSDAT(F,OIENS,.06,"E"))

 .S MUC=$G(PSDAT(F,OIENS,.07,"E"))

 .D C S @GBL@(CNT,0)="<Measurement>"

 .D C S @GBL@(CNT,0)="<Dimension>"_DIMENS_"</Dimension>"

 .D C S @GBL@(CNT,0)="<Value>"_VALUE_"</Value>"

 .I $L(OBDATE) D

 ..D C S @GBL@(CNT,0)="<ObservationDate>"

 ..D C S @GBL@(CNT,0)="<Date>"_OBDATE_"</Date>"

 ..D C S @GBL@(CNT,0)="</ObservationDate>"

 .I $L(MDQ) D C S @GBL@(CNT,0)="<MeasurementDataQualifier>"_MDQ_"</MeasurementDataQualifier>"

 .I $L(MSC) D C S @GBL@(CNT,0)="<MeasurementSourceCode>"_MSC_"</MeasurementSourceCode>"

 .I $L(MUC) D C S @GBL@(CNT,0)="<MeasurementUnitCode>"_MUC_"</MeasurementUnitCode>"

 .D C S @GBL@(CNT,0)="</Measurement>"

 I $L(OBNOTE) D

 .D C S @GBL@(CNT,0)="<ObservationNotes>"_OBNOTE_"</ObservationNotes>"

 D C S @GBL@(CNT,0)="</Observation>"

 Q

DRUGEVAL(GBL,IEN) ;

 N F,SRC,PSC,SERVRC,CAID,CAQ,CSC,AR,PSDAT,DLOOP

 Q

 S F=52.4916

 S DLOOP=0 F  S DLOOP=$O(^PS(52.49,IEN,16,DLOOP)) Q:'DLOOP  D

 .S IENS=IEN_","_DLOOP_","

 .K PSDAT D GETS^DIQ(F,IENS,"**","IE","PSDAT")

 .D CONVXML^PSOERXX1("PSDAT")

 .S SRC=$G(PSDAT(F,IENS,.01,"E"))

 .S PSC=$G(PSDAT(F,IENS,.02,"E"))

 .S SERVRC=$G(PSDAT(F,IENS,.03,"E"))

 .S CAID=$G(PSDAT(F,IENS,.04,"E"))

 .S CAQ=$G(PSDAT(F,IENS,.05,"E"))

 .S CSC=$G(PSDAT(F,IENS,.06,"E"))

 .S AR=$G(PSDAT(F,IENS,1,"E"))

 .D C S @GBL@(CNT,0)="<DrugUseEvaluation>"

 .D C S @GBL@(CNT,0)="<ServiceReasonCode>"_SRC_"</ServiceReasonCode>"

 .D C S @GBL@(CNT,0)="<ProfessionalServiceCode>"_PSC_"</ProfessionalServiceCode>"

 .D C S @GBL@(CNT,0)="<ServiceResultCode>"_SERVRC_"</ServiceResultCode>"

 .D C S @GBL@(CNT,0)="<CoAgent>"

 .D C S @GBL@(CNT,0)="<CoAgentID>"_CAID_"</CoAgentID>"

 .D C S @GBL@(CNT,0)="<CoAgentQualifier>"_CAQ_"</CoAgentQualifier>"

 .D C S @GBL@(CNT,0)="</CoAgent>"

 .D C S @GBL@(CNT,0)="<ClinicalSignificanceCode>"_CSC_"</ClinicalSignificanceCode>"

 .D C S @GBL@(CNT,0)="<AcknowledgementReason>"_AR_"</AcknowledgementReason>"

 .D C S @GBL@(CNT,0)="</DrugUseEvaluation>"

 Q

DIAGNOS(GBL,IENS) ;

 N F,CIQ,PQUAL,PVAL,SQUAL,SVAL,PSDAT

 S F=52.499

 D GETS^DIQ(F,IENS,"**","IE","PSDAT")

 D CONVXML^PSOERXX1("PSDAT")

 S CIQ=$G(PSDAT(F,IENS,1,"E"))

 S PQUAL=$G(PSDAT(F,IENS,1,"E"))

 S PVAL=$G(PSDAT(F,IENS,1,"E"))

 S SQUAL=$G(PSDAT(F,IENS,1,"E"))

 S SVAL=$G(PSDAT(F,IENS,1,"E"))

 ;FUTURE ENHANCEMENT - FOR NOW JUST BUILD HEADER/FOOTER AND QUIT, LATER BUILD THE REST

 D C S @GBL@(CNT,0)="<Diagnosis>"

 D C S @GBL@(CNT,0)="</Diagnosis>"

 Q

 D C S @GBL@(CNT,0)="<Diagnosis>"

 D C S @GBL@(CNT,0)="<ClinicalInformationQualifier>"_CIQ_"</ClinicalInformationQualifier>"

 D C S @GBL@(CNT,0)="<Primary>"

 D C S @GBL@(CNT,0)="<Qualifier>"_PQUAL_"</Qualifier>"

 D C S @GBL@(CNT,0)="<Value>"_PVAL_"</Value>"

 D C S @GBL@(CNT,0)="</Primary>"

 D C S @GBL@(CNT,0)="<Secondary>"

 D C S @GBL@(CNT,0)="<Qualifier>"_SQUAL_"</Qualifier>"

 D C S @GBL@(CNT,0)="<Value>"_SVAL_"</VALUE>"

 D C S @GBL@(CNT,0)="</Secondary>"

 D C S @GBL@(CNT,0)="</Diagnosis>"

 Q

C ;

 S CNT=$G(CNT)+1

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSOERXX3   9975     printed  Apr 23, 2025@18:43:42                                                                                                                                                                                                    Page 2

PSOERXX3  ;ALB/BWF - eRx xml utilities ; 8/3/2016 5:14pm

 +1       ;;7.0;OUTPATIENT PHARMACY;**467,508,551**;DEC 1997;Build 37

 +2       ;

 +3        QUIT 

PATIENT(GBL,PSOISTE,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

 +3        SET F=52.46

 +4        SET PIEN=$$GET1^DIQ(52.49,IEN,.04,"I")

           if 'PIEN

               QUIT 

 +5        SET PIENS=PIEN_","

 +6        DO GETS^DIQ(F,PIENS,"**","IE","PSDAT")

 +7        DO CONVXML^PSOERXX1("PSDAT")

 +8        SET PATREL=$GET(PSDAT(F,PIENS,1.7,"I"))

 +9        SET LNAME=$GET(PSDAT(F,PIENS,.02,"E"))

 +10       SET FNAME=$GET(PSDAT(F,PIENS,.03,"E"))

 +11       SET MNAME=$GET(PSDAT(F,PIENS,.04,"E"))

 +12       SET SUFF=$GET(PSDAT(F,PIENS,.05,"E"))

 +13       SET PREF=$GET(PSDAT(F,PIENS,.06,"E"))

 +14       SET GENDER=$GET(PSDAT(F,PIENS,.07,"I"))

 +15      ; DOB NEEDS TO BE CONVERTED

 +16       SET DOB=$GET(PSDAT(F,PIENS,.08,"I"))

           IF DOB

               SET DOB=$PIECE($$EXTIME^PSOERXO1(DOB),"T")

 +17       SET ADDL1=$GET(PSDAT(F,PIENS,3.1,"E"))

 +18       SET ADDL2=$GET(PSDAT(F,PIENS,3.2,"E"))

 +19       SET CITY=$GET(PSDAT(F,PIENS,3.3,"E"))

 +20       SET STATE=$GET(PSDAT(F,PIENS,3.4,"I"))

 +21       SET STATE=$$STRES^PSOERXX2(STATE,PSOSITE)

 +22       SET ZIP=$GET(PSDAT(F,PIENS,3.5,"E"))

 +23       SET PLQ=$GET(PSDAT(F,PIENS,1.6,"E"))

 +24       SET PSSN=$GET(PSDAT(F,PIENS,1.4,"E"))

 +25      ; FUTURE ENHANCEMENT, GRAB CUNIT/BED/ROOM FROM CORRECT LOCATIONS. THIS LOGIC IS NOT ACTIVE WITH VERSION 2 

 +26       SET CUNIT=$GET(PSDAT(F,PIENS,1,"E"))

 +27       SET BED=$GET(PSDAT(F,PIENS,1,"E"))

 +28       SET ROOM=$GET(PSDAT(F,PIENS,1,"E"))

 +29       DO C

           SET @GBL@(CNT,0)="<Patient>"

 +30       IF $LENGTH(PATREL)

               DO C

               SET @GBL@(CNT,0)="<PatientRelationship>"_PATREL_"</PatientRelationship>"

 +31       IF '$ORDER(^PS(52.46,PIEN,5,0))

               Begin DoDot:1

 +32               IF PSSN

                       Begin DoDot:2

 +33                       DO C

                           SET @GBL@(CNT,0)="<Identification>"

 +34                       DO C

                           SET @GBL@(CNT,0)="<SocialSecurity>"_PSSN_"</SocialSecurity>"

 +35                       DO C

                           SET @GBL@(CNT,0)="</Identification>"

                       End DoDot:2

               End DoDot:1

 +36       IF $ORDER(^PS(52.46,PIEN,5,0))

               Begin DoDot:1

 +37               DO C

                   SET @GBL@(CNT,0)="<Identification>"

 +38               SET ILOOP=0

                   FOR 

                       SET ILOOP=$ORDER(^PS(52.46,PIEN,5,ILOOP))

                       if 'ILOOP

                           QUIT 

                       Begin DoDot:2

 +39                       SET ITYP=$$GET1^DIQ(52.465,ILOOP_","_PIENS,.01,"E")

 +40                       SET IVAL=$$GET1^DIQ(52.465,ILOOP_","_PIENS,.02,"E")

 +41                       DO IDENT^PSOERXX2(.GBL,ITYP,IVAL)

                       End DoDot:2

 +42               DO C

                   SET @GBL@(CNT,0)="</Identification>"

               End DoDot:1

 +43       DO C

           SET @GBL@(CNT,0)="<Name>"

 +44       IF $LENGTH(LNAME)

               DO C

               SET @GBL@(CNT,0)="<LastName>"_LNAME_"</LastName>"

 +45       IF $LENGTH(FNAME)

               DO C

               SET @GBL@(CNT,0)="<FirstName>"_FNAME_"</FirstName>"

 +46       IF $LENGTH(MNAME)

               DO C

               SET @GBL@(CNT,0)="<MiddleName>"_MNAME_"</MiddleName>"

 +47       IF $LENGTH(SUFF)

               DO C

               SET @GBL@(CNT,0)="<Suffix>"_SUFF_"</Suffix>"

 +48       IF $LENGTH(PREF)

               DO C

               SET @GBL@(CNT,0)="<Prefix>"_PREF_"</Prefix>"

 +49       DO C

           SET @GBL@(CNT,0)="</Name>"

 +50       IF $LENGTH(GENDER)

               DO C

               SET @GBL@(CNT,0)="<Gender>"_GENDER_"</Gender>"

 +51       IF $LENGTH(DOB)

               Begin DoDot:1

 +52               DO C

                   SET @GBL@(CNT,0)="<DateOfBirth>"

 +53               DO C

                   SET @GBL@(CNT,0)="<Date>"_DOB_"</Date>"

 +54               DO C

                   SET @GBL@(CNT,0)="</DateOfBirth>"

               End DoDot:1

 +55       IF $LENGTH(ADDL1)

               Begin DoDot:1

 +56               DO C

                   SET @GBL@(CNT,0)="<Address>"

 +57               IF $LENGTH(ADDL1)

                       DO C

                       SET @GBL@(CNT,0)="<AddressLine1>"_ADDL1_"</AddressLine1>"

 +58               IF $LENGTH(ADDL2)

                       DO C

                       SET @GBL@(CNT,0)="<AddressLine2>"_ADDL2_"</AddressLine2>"

 +59               IF $LENGTH(CITY)

                       DO C

                       SET @GBL@(CNT,0)="<City>"_CITY_"</City>"

 +60               IF $LENGTH(STATE)

                       DO C

                       SET @GBL@(CNT,0)="<State>"_STATE_"</State>"

 +61               IF $LENGTH(ZIP)

                       DO C

                       SET @GBL@(CNT,0)="<ZipCode>"_ZIP_"</ZipCode>"

 +62               IF $LENGTH(PLQ)

                       DO C

                       SET @GBL@(CNT,0)="<PlaceLocationQualifier>"_PLQ_"</PlaceLocationQualifier>"

 +63               DO C

                   SET @GBL@(CNT,0)="</Address>"

               End DoDot:1

 +64       IF $ORDER(^PS(52.46,PIEN,3,0))

               Begin DoDot:1

 +65               DO C

                   SET @GBL@(CNT,0)="<CommunicationNumbers>"

 +66               SET CLOOP=0

                   FOR 

                       SET CLOOP=$ORDER(^PS(52.46,PIEN,3,CLOOP))

                       if 'CLOOP

                           QUIT 

                       Begin DoDot:2

 +67                       SET CNUM=$$GET1^DIQ(52.462,CLOOP_","_PIENS,.01,"E")

 +68                       SET CQUAL=$$GET1^DIQ(52.462,CLOOP_","_PIENS,.02,"I")

 +69                       DO COMMNUM^PSOERXX2(.GBL,CNUM,CQUAL)

                       End DoDot:2

 +70               DO C

                   SET @GBL@(CNT,0)="</CommunicationNumbers>"

               End DoDot:1

 +71       IF $LENGTH(CUNIT)!($LENGTH(BED))!($LENGTH(ROOM))

               Begin DoDot:1

 +72               DO C

                   SET @GBL@(CNT,0)="<PatientLocation>"

 +73               IF $LENGTH(CUNIT)

                       DO C

                       SET @GBL@(CNT,0)="<FacilityUnit>"_CUNIT_"</FacilityUnit>"

 +74               IF $LENGTH(BED)

                       DO C

                       SET @GBL@(CNT,0)="<Bed>"_BED_"</Bed>"

 +75               IF $LENGTH(ROOM)

                       DO C

                       SET @GBL@(CNT,0)="<Room>"_ROOM_"</Room>"

 +76               DO C

                   SET @GBL@(CNT,0)="</PatientLocation>"

               End DoDot:1

 +77       DO C

           SET @GBL@(CNT,0)="</Patient>"

 +78       QUIT 

FILLST(GBL,FTYPE,FNOTE) ;

 +1        DO C

           SET @GBL@(CNT,0)="<FillStatus>"

 +2        DO C

           SET @GBL@(CNT,0)=$SELECT(FTYPE="F":"<Filled>",FTYPE="P":"<PartialFill>",1:"")

 +3        DO C

           SET @GBL@(CNT,0)="<Note>"_FNOTE_"</Note>"

 +4        DO C

           SET @GBL@(CNT,0)=$SELECT(FTYPE="F":"</Filled>",FTYPE="P":"</PartialFill>",1:"")

 +5        DO C

           SET @GBL@(CNT,0)="</FillStatus>"

 +6        QUIT 

BENEFITS(GBL,IEN) ;

 +1        NEW F,NCPDPID,NCPDPID,PAYNAME,CARDID,LNAME,FNAME,MNAME,SUFF,PREF,GID,PSDAT,BIENS,BLOOP,IDLOOP

 +2        SET IENS=IEN_","

 +3        SET F=52.4918

 +4        IF '$ORDER(^PS(52.49,IEN,18,0))

               QUIT 

 +5        DO C

           SET @GBL@(CNT,0)="<BenefitsCoordination>"

 +6        SET BLOOP=0

           FOR 

               SET BLOOP=$ORDER(^PS(52.49,IEN,18,BLOOP))

               if 'BLOOP

                   QUIT 

               Begin DoDot:1

 +7                SET BIENS=BLOOP_","_IENS

 +8                KILL PSDAT

 +9                DO GETS^DIQ(F,BIENS,"**","IE","PSDAT")

 +10               DO CONVXML^PSOERXX1("PSDAT")

 +11      ; FUTURE ENHANCEMENT - the IDENTIFICATION multiple is where the NCPDPID info belongs, USE IDENTIFICATION MULTIPLE IN THE PAYER SUBFILE

 +12      ;S NCPDPID=$G(PSDAT(F,IENS,1,"E"))

 +13      ;FUTURE ENHANCEMENT - STORE PAYER NAME DIFFERENTLY AN..35

 +14               SET PAYNAME=$EXTRACT($GET(PSDAT(F,BIENS,.03,"E")),1,35)

 +15               SET CARDID=$GET(PSDAT(F,BIENS,7,"E"))

 +16               SET LNAME=$GET(PSDAT(F,BIENS,1,"E"))

 +17               SET FNAME=$GET(PSDAT(F,BIENS,2,"E"))

 +18               SET MNAME=$GET(PSDAT(F,BIENS,3,"E"))

 +19               SET SUFF=$GET(PSDAT(F,BIENS,4,"E"))

 +20               SET PREF=$GET(PSDAT(F,BIENS,5,"E"))

 +21               SET GID=$GET(PSDAT(F,BIENS,.02,"E"))

 +22      ; PAYER IDENTIFICATION INFORMATION

 +23               IF $DATA(^PS(52.49,IEN,18,BLOOP,6))

                       Begin DoDot:2

 +24                       SET IDLOOP=0

                           FOR 

                               SET IDLOOP=$ORDER(^PS(52.49,IEN,18,BLOOP,6,IDLOOP))

                               if 'IDLOOP

                                   QUIT 

                               Begin DoDot:3

 +25                               DO C

                                   SET @GBL@(CNT,0)="<PayerIdentification>"

 +26                               SET ITYP=$$GET1^DIQ(52.49186,IDLOOP_","_BLOOP_","_IENS,.01,"E")

 +27                               SET IVAL=$$GET1^DIQ(52.49186,IDLOOP_","_BLOOP_","_IENS,.02,"E")

 +28                               DO C

                                   SET @GBL@(CNT,0)="<"_ITYP_">"_IVAL_"</"_ITYP_">"

 +29                               DO C

                                   SET @GBL@(CNT,0)="</PayerIdentification>"

                               End DoDot:3

 +30      ;D C S @GBL@(CNT,0)="</PayerIdentification>"

                       End DoDot:2

 +31               IF $LENGTH(PAYNAME)

                       DO C

                       SET @GBL@(CNT,0)="<PayerName>"_PAYNAME_"</PayerName>"

 +32               IF $LENGTH(CARDID)

                       DO C

                       SET @GBL@(CNT,0)="<CardholderID>"_CARDID_"</CardholderID>"

 +33               IF ($LENGTH(LNAME))!($LENGTH(FNAME))!($LENGTH(MNAME))!($LENGTH(SUFF))!($LENGTH(PREF))

                       Begin DoDot:2

 +34                       DO C

                           SET @GBL@(CNT,0)="<CardHolderName>"

 +35      ;/BLB/ - PSO*7*551 BEGIN CHANGE - PREVENT EMPTY SECTIONS

 +36                       IF $LENGTH(LNAME)

                               DO C

                               SET @GBL@(CNT,0)="<LastName>"_LNAME_"</LastName>"

 +37                       IF $LENGTH(FNAME)

                               DO C

                               SET @GBL@(CNT,0)="<FirstName>"_FNAME_"</FirstName>"

 +38                       IF $LENGTH(MNAME)

                               DO C

                               SET @GBL@(CNT,0)="<MiddleName>"_MNAME_"</MiddleName>"

 +39                       IF $LENGTH(SUFF)

                               DO C

                               SET @GBL@(CNT,0)="<Suffix>"_SUFF_"</Suffix>"

 +40                       IF $LENGTH(PREF)

                               DO C

                               SET @GBL@(CNT,0)="<Prefix>"_PREF_"</Prefix>"

 +41                       DO C

                           SET @GBL@(CNT,0)="</CardHolderName>"

                       End DoDot:2

 +42               IF $LENGTH(GID)

                       DO C

                       SET @GBL@(CNT,0)="<GroupID>"_GID_"</GroupID>"

               End DoDot:1

 +43       DO C

           SET @GBL@(CNT,0)="</BenefitsCoordination>"

 +44       QUIT 

 +45      ;/BLB/ PSO*7.0*551 - END CHANGE

OBSERVE(GBL,IEN) ;

 +1        NEW F,DIMENS,VALUE,OBDATE,MDQ,MSC,MUC,OBNOTE,PSDAT,OIENS,OLOOP

 +2        SET F=52.4914

 +3        SET OBNOTE=$$GET1^DIQ(52.49,IEN,15,"E")

           SET OBNOTE=$$SYMENC^MXMLUTL(OBNOTE)

 +4        SET IENS=IEN_","

 +5        IF '$ORDER(^PS(52.49,IEN,14,0))

               QUIT 

 +6        DO C

           SET @GBL@(CNT,0)="<Observation>"

 +7        SET OLOOP=0

           FOR 

               SET OLOOP=$ORDER(^PS(52.49,IEN,14,OLOOP))

               if 'OLOOP

                   QUIT 

               Begin DoDot:1

 +8                SET OIENS=OLOOP_","_IENS

 +9                KILL PSDAT

 +10               DO GETS^DIQ(F,OIENS,"**","IE","PSDAT")

 +11               DO CONVXML^PSOERXX1("PSDAT")

 +12               SET DIMENS=$GET(PSDAT(F,OIENS,.02,"E"))

 +13               SET VALUE=$GET(PSDAT(F,OIENS,.03,"E"))