source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFBK3.m@ 1464

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