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 ---[H[J[2J[HPSOERXX3 9975 printed Dec 13, 2024@02:29:15 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"))
+14 ; convert observation date
+15 SET OBDATE=$GET(PSDAT(F,OIENS,.04,"I"))
IF OBDATE
SET OBDATE=$PIECE($$EXTIME^PSOERXO1(OBDATE),"T")
+16 SET MDQ=$GET(PSDAT(F,OIENS,.05,"I"))
+17 SET MSC=$GET(PSDAT(F,OIENS,.06,"E"))
+18 SET MUC=$GET(PSDAT(F,OIENS,.07,"E"))
+19 DO C
SET @GBL@(CNT,0)="<Measurement>"
+20 DO C
SET @GBL@(CNT,0)="<Dimension>"_DIMENS_"</Dimension>"
+21 DO C
SET @GBL@(CNT,0)="<Value>"_VALUE_"</Value>"
+22 IF $LENGTH(OBDATE)
Begin DoDot:2
+23 DO C
SET @GBL@(CNT,0)="<ObservationDate>"
+24 DO C
SET @GBL@(CNT,0)="<Date>"_OBDATE_"</Date>"
+25 DO C
SET @GBL@(CNT,0)="</ObservationDate>"
End DoDot:2
+26 IF $LENGTH(MDQ)
DO C
SET @GBL@(CNT,0)="<MeasurementDataQualifier>"_MDQ_"</MeasurementDataQualifier>"
+27 IF $LENGTH(MSC)
DO C
SET @GBL@(CNT,0)="<MeasurementSourceCode>"_MSC_"</MeasurementSourceCode>"
+28 IF $LENGTH(MUC)
DO C
SET @GBL@(CNT,0)="<MeasurementUnitCode>"_MUC_"</MeasurementUnitCode>"
+29 DO C
SET @GBL@(CNT,0)="</Measurement>"
End DoDot:1
+30 IF $LENGTH(OBNOTE)
Begin DoDot:1
+31 DO C
SET @GBL@(CNT,0)="<ObservationNotes>"_OBNOTE_"</ObservationNotes>"
End DoDot:1
+32 DO C
SET @GBL@(CNT,0)="</Observation>"
+33 QUIT
DRUGEVAL(GBL,IEN) ;
+1 NEW F,SRC,PSC,SERVRC,CAID,CAQ,CSC,AR,PSDAT,DLOOP
+2 QUIT
+3 SET F=52.4916
+4 SET DLOOP=0
FOR
SET DLOOP=$ORDER(^PS(52.49,IEN,16,DLOOP))
if 'DLOOP
QUIT
Begin DoDot:1
+5 SET IENS=IEN_","_DLOOP_","
+6 KILL PSDAT
DO GETS^DIQ(F,IENS,"**","IE","PSDAT")
+7 DO CONVXML^PSOERXX1("PSDAT")
+8 SET SRC=$GET(PSDAT(F,IENS,.01,"E"))
+9 SET PSC=$GET(PSDAT(F,IENS,.02,"E"))
+10 SET SERVRC=$GET(PSDAT(F,IENS,.03,"E"))
+11 SET CAID=$GET(PSDAT(F,IENS,.04,"E"))
+12 SET CAQ=$GET(PSDAT(F,IENS,.05,"E"))
+13 SET CSC=$GET(PSDAT(F,IENS,.06,"E"))
+14 SET AR=$GET(PSDAT(F,IENS,1,"E"))
+15 DO C
SET @GBL@(CNT,0)="<DrugUseEvaluation>"
+16 DO C
SET @GBL@(CNT,0)="<ServiceReasonCode>"_SRC_"</ServiceReasonCode>"
+17 DO C
SET @GBL@(CNT,0)="<ProfessionalServiceCode>"_PSC_"</ProfessionalServiceCode>"
+18 DO C
SET @GBL@(CNT,0)="<ServiceResultCode>"_SERVRC_"</ServiceResultCode>"
+19 DO C
SET @GBL@(CNT,0)="<CoAgent>"
+20 DO C
SET @GBL@(CNT,0)="<CoAgentID>"_CAID_"</CoAgentID>"
+21 DO C
SET @GBL@(CNT,0)="<CoAgentQualifier>"_CAQ_"</CoAgentQualifier>"
+22 DO C
SET @GBL@(CNT,0)="</CoAgent>"
+23 DO C
SET @GBL@(CNT,0)="<ClinicalSignificanceCode>"_CSC_"</ClinicalSignificanceCode>"
+24 DO C
SET @GBL@(CNT,0)="<AcknowledgementReason>"_AR_"</AcknowledgementReason>"
+25 DO C
SET @GBL@(CNT,0)="</DrugUseEvaluation>"
End DoDot:1
+26 QUIT
DIAGNOS(GBL,IENS) ;
+1 NEW F,CIQ,PQUAL,PVAL,SQUAL,SVAL,PSDAT
+2 SET F=52.499
+3 DO GETS^DIQ(F,IENS,"**","IE","PSDAT")
+4 DO CONVXML^PSOERXX1("PSDAT")
+5 SET CIQ=$GET(PSDAT(F,IENS,1,"E"))
+6 SET PQUAL=$GET(PSDAT(F,IENS,1,"E"))
+7 SET PVAL=$GET(PSDAT(F,IENS,1,"E"))
+8 SET SQUAL=$GET(PSDAT(F,IENS,1,"E"))
+9 SET SVAL=$GET(PSDAT(F,IENS,1,"E"))
+10 ;FUTURE ENHANCEMENT - FOR NOW JUST BUILD HEADER/FOOTER AND QUIT, LATER BUILD THE REST
+11 DO C
SET @GBL@(CNT,0)="<Diagnosis>"
+12 DO C
SET @GBL@(CNT,0)="</Diagnosis>"
+13 QUIT
+14 DO C
SET @GBL@(CNT,0)="<Diagnosis>"
+15 DO C
SET @GBL@(CNT,0)="<ClinicalInformationQualifier>"_CIQ_"</ClinicalInformationQualifier>"
+16 DO C
SET @GBL@(CNT,0)="<Primary>"
+17 DO C
SET @GBL@(CNT,0)="<Qualifier>"_PQUAL_"</Qualifier>"
+18 DO C
SET @GBL@(CNT,0)="<Value>"_PVAL_"</Value>"
+19 DO C
SET @GBL@(CNT,0)="</Primary>"
+20 DO C
SET @GBL@(CNT,0)="<Secondary>"
+21 DO C
SET @GBL@(CNT,0)="<Qualifier>"_SQUAL_"</Qualifier>"
+22 DO C
SET @GBL@(CNT,0)="<Value>"_SVAL_"</VALUE>"
+23 DO C
SET @GBL@(CNT,0)="</Secondary>"
+24 DO C
SET @GBL@(CNT,0)="</Diagnosis>"
+25 QUIT
C ;
+1 SET CNT=$GET(CNT)+1
+2 QUIT
