IBDFBK3 ;ALB/AAS - AICS broker Utilities ;23-May-95 ;;3.0;AUTOMATED INFO COLLECTION SYS;**12,38,36**;APR 24, 1997 ; LSTDATA(RESULT,PXCA,LCNT) ; ; -- expand the PXCA array data into human readable terms for ; display on the workstation ; ; Input : Result - (called by reference, see output) ; PXCA - (by referencethe array of data formated to ; the PCE device interface specification ; lcnt - (by reference) a counter for the result array ; Output: RESULT - a new array element result(lcnt) will be ; created for each piece of data received ; N I,J,M,X,IBX ; ; -- noshow, cancel or reschedule checked I $D(PXCA("IBD-ABORT")) D .S I="" F S I=$O(PXCA("IBD-ABORT",I)) Q:I="" S J="" F S J=$O(PXCA("IBD-ABORT",I,J)) Q:J="" D ..S IBX=PXCA("IBD-ABORT",I,J) ..S X="The following Data was NOT Sent to PCE because "_$P(IBX,"^",2)_" was marked!" ..D NEWLINE(.RESULT,X,.LCNT) .Q ; ; -- expand the encounter node I $D(PXCA("ENCOUNTER")) S IBX=PXCA("ENCOUNTER") D .I $P(IBX,"^",14) S X="Checkout Date/Time: "_$$FMTE^XLFDT($P(IBX,"^",14)) D NEWLINE(.RESULT,X,.LCNT) .I $P(IBX,"^",4) S X=$S($P(IBX,"^",15)="P":"Primary ",$P(IBX,"^",15)="S":"Secondary ",1:"")_"Provider: "_$P($G(^VA(200,+$P(IBX,"^",4),0)),"^") D NEWLINE(.RESULT,X,.LCNT) .;; --change to api cpt ; dhh .I $P(IBX,"^",5) S X=$P(IBX,"^",5) D .. I X'="" D ... N IBVST ... S X=$$CPT^ICPTCOD(X) ... S (X,IBVST)=$S(+X=-1:"",1:$P(X,"^",2)) ... S X="Visit Type CPT: "_X D NEWLINE(.RESULT,X,.LCNT) ... I $D(PXCA("ENCOUNTER","MODIFIER")) D .... S X=" Modifier(s): " D NEWLINE(.RESULT,X,.LCNT) .... N IBM S IBM=0 .... F S IBM=$O(PXCA("ENCOUNTER","MODIFIER",IBM)) Q:IBM']"" D ..... N IBMDESC S IBMDESC=$$MODP^ICPTMOD(IBVST,IBM,"E") Q:+IBMDESC<0 ..... S X=" "_IBM_"-"_$P(IBMDESC,"^",2) ..... D NEWLINE(.RESULT,X,.LCNT) .; add sc,ao,ir,ec,mst,eligibility,credit stop (pieces 6-10,13,17) .I $P(IBX,"^",6) D NEWLINE(.RESULT,"Visit for SC Condition",.LCNT) .I $P(IBX,"^",7) D NEWLINE(.RESULT,"Visit for Agent Orange Condition",.LCNT) .I $P(IBX,"^",8) D NEWLINE(.RESULT,"Visit for Ionizing Radiation Condition",.LCNT) .I $P(IBX,"^",9) D NEWLINE(.RESULT,"Visit for Environmental Contaminates Condition",.LCNT) .I $P(IBX,"^",10) D NEWLINE(.RESULT,"Visit for MST",.LCNT) .I $P(IBX,"^",13) D NEWLINE(.RESULT,"Eligibility for Visit: "_$P($G(^DIC(8,+$P(IBX,"^",13),0)),"^"),.LCNT) .I $P(IBX,"^",17) D NEWLINE(.RESULT,"Additional Credit Stop: "_$P($G(^DIC(40.7,+$P(IBX,"^",17),0)),"^"),.LCNT) ; ; -- expand the other nodes F M="DIAGNOSIS/PROBLEM","PROVIDER","DIAGNOSIS","PROCEDURE","VITALS","PROBLEM","EXAM","IMMUNIZATION","HEALTH FACTORS","SKIN TEST","PATIENT ED","LOCAL" I $D(PXCA(M)) D .S I="" F S I=$O(PXCA(M,I)) Q:I="" D:M="PROVIDER" PROV S J="" F S J=$O(PXCA(M,I,J)) Q:J="" D ..K X S IBX=PXCA(M,I,J) D D:$D(X) NEWLINE(.RESULT,X,.LCNT) ...; ...I M="DIAGNOSIS" S X=$S($P(IBX,"^",2)="P":"Primary",$P(IBX,"^",2)="S":"Secondary",1:"")_" Diagnosis: "_$P($G(^ICD9(+$P($G(IBX),"^"),0)),"^")_" - "_$P(IBX,"^",9)_" - "_$P(IBX,"^",8) Q ...; ...I M="PROCEDURE" D ....I +IBX D ..... S X=$$CPT^ICPTCOD(+IBX) ..... S X=$S(X=-1:"",1:$P(X,"^",2)) ..... S X="Procedure: "_X_" - "_$P(IBX,"^",7)_" - "_$P(IBX,"^",6)_" - "_$S($P(IBX,"^",2)="P":"Primary ",$P(IBX,"^",2)="S":"Secondary ",1:"Quantity: "_+$P(IBX,"^",2)) ..... Q ....I 'IBX S X="Treatment: "_$P(IBX,"^",6) ...; ...I M="VITALS" S X="Vital Sign: "_$$VTYPE($P(IBX,"^"))_": "_$P(IBX,"^",2) Q ...; ...I M="IMMUNIZATION" S X="Immunization: "_$$DSPLYIM^PXAPIIB(+IBX) I $P(IBX,"^",5) S X=X_" - Contraindicated" Q ...; ...I M="EXAM" S X="Exam: "_$$DSPLYEX^PXAPIIB(+IBX)_$S($P(IBX,"^",2)="A":" Abnormal",$P(IBX,"^",2)="N":" Normal",1:"") Q ...; ...I M="PROBLEM" S X="Problem List: "_$P(IBX,"^") Q ...; ...I M="HEALTH FACTORS" S X="Health Factor: "_$$DSPLYHF^PXAPIIB(+IBX) N Y S Y=$P(IBX,"^",2) I Y'="" S X=X_" Level/Severity: "_$S(Y="M":"Minimal",Y="MO":"Moderate",Y="H":"Heavy/Severe",1:"") Q ...; ...I M="SKIN TEST" S X="Skin Tests: "_$$DSPLYSK^PXAPIIB(+IBX) Q ...; ...I M="PATIENT ED" S X="Patient Eduction: "_$$DSPLYED^PXAPIIB(+IBX) I $P(IBX,"^",2) S X=X_" , Level of Understanding: "_$S(IBX=1:"Poor",IBX=2:"Fair",IBX=3:"Good",IBX=4:"N/A",IBX=5:"Refused",1:"") Q ...; ...I M="DIAGNOSIS/PROBLEM" D S:X="" X="Diagnosis/Problem: unspecified" ....N Y S X="" ....S Y=$P(IBX,"^",2) S X=$S(Y="P":"Primary ",Y="S":"Secondary ",1:"")_"Diagnosis/Problem" ....;I $P(IBX,"^",4) S X=X_$S($P(IBX,"^",6)="I":", Inactive",1:", Active") ....I $P(IBX,"^",13)'="" S X=X_" '"_$P(IBX,"^",14)_$S($P(IBX,"^",14)'="":" ",1:"")_$P(IBX,"^",13)_"'" ....;I +$P(IBX,"^",3) S X=X_", Clinical Lexicon term: "_$P($G(^GMP(757.01,+$P(IBX,"^",3),0)),"^") ;clinical lexicon term passed ....I +$P(IBX,"^",3) S X=X_", Clinical Lexicon term: " D .....I $D(^LEX) S X=X_$P($G(^LEX(757.01,+$P(IBX,"^",3),0)),"^") Q .....S X=X_$P($G(^GMP(757.01,+$P(IBX,"^",3),0)),"^") ....I $P(IBX,"^",5) S X=X_", Added to Problem List " ....I +$P(IBX,"^",4) S X=X_", Patient Active Problem: "_$$PROBNAR($P(IBX,"^",4)) ;problem entry passed ....I +IBX S IBY=$P($G(^ICD9(+IBX,0)),"^") I IBX'[IBY S X=X_", ICD9: "_IBY ....I $P(IBX,"^",9) S X=X_" SC Condition " ....I $P(IBX,"^",10) S X=X_" AO Condition " ....I $P(IBX,"^",11) S X=X_" IR Condition " ....I $P(IBX,"^",12) S X=X_" EC Condition " ...I M="LOCAL" S X="Local Data Received: "_IBX Q ..I M="PROCEDURE",$D(PXCA(M,I,J)) D MODLIST LSTQ Q ; MODLIST ; -- expand the modifiers filed N IBM,X S IBM=0 S X=" Modifier(s): " D NEWLINE(.RESULT,X,.LCNT) F S IBM=$O(PXCA(M,I,J,IBM)) Q:IBM']"" D . S X=" "_IBM_"-"_$P(PXCA(M,I,J,IBM),"^",3) . D NEWLINE(.RESULT,X,.LCNT) Q PROV ; -- expand the additional provider node S IBX=$G(PXCA(M,I)) S X=$S($E(IBX,1)="P":"Primary ",$E(IBX,1)="S":"Secondary ",1:"")_"Provider: "_$P($G(^VA(200,I,0)),"^")_$S($P(IBX,"^",2)=1:" Attending",1:"") D NEWLINE(.RESULT,X,.LCNT) Q ; NEWLINE(RESULT,X,LCNT) ; ; -- increment count and add new line to results array. S LCNT=LCNT+1 S RESULT(LCNT)=X Q ; VTYPE(X) ; ; -- Vital sign type from codes S X=$G(X) Q $S(X="BP":"Blood Pressure",X="HT":"Height",X="WT":"Weight",X="TMP":"Temperature",X="PU":"Pulse",1:"Other Vital") ; PROBNAR(IEN) ; -- display problem narrative ; Q $P($G(^AUTNPOV(+$P($G(^AUPNPROB(+$G(IEN),0)),"^",5),0)),"^") ; PROBDIA(IEN) ; -- return problem diagnosis code pointer Q +$P($G(^AUPNPROB(+$G(IEN),0)),"^")