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)),"^")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFBK3 6607 printed Apr 09, 2024@20:47:50 Page 2
IBDFBK3 ;ALB/AAS - AICS broker Utilities ;23-May-95
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**12,38,36**;APR 24, 1997
+2 ;
LSTDATA(RESULT,PXCA,LCNT) ;
+1 ; -- expand the PXCA array data into human readable terms for
+2 ; display on the workstation
+3 ;
+4 ; Input : Result - (called by reference, see output)
+5 ; PXCA - (by referencethe array of data formated to
+6 ; the PCE device interface specification
+7 ; lcnt - (by reference) a counter for the result array
+8 ; Output: RESULT - a new array element result(lcnt) will be
+9 ; created for each piece of data received
+10 ;
+11 NEW I,J,M,X,IBX
+12 ;
+13 ; -- noshow, cancel or reschedule checked
+14 IF $DATA(PXCA("IBD-ABORT"))
Begin DoDot:1
+15 SET I=""
FOR
SET I=$ORDER(PXCA("IBD-ABORT",I))
if I=""
QUIT
SET J=""
FOR
SET J=$ORDER(PXCA("IBD-ABORT",I,J))
if J=""
QUIT
Begin DoDot:2
+16 SET IBX=PXCA("IBD-ABORT",I,J)
+17 SET X="The following Data was NOT Sent to PCE because "_$PIECE(IBX,"^",2)_" was marked!"
+18 DO NEWLINE(.RESULT,X,.LCNT)
End DoDot:2
+19 QUIT
End DoDot:1
+20 ;
+21 ; -- expand the encounter node
+22 IF $DATA(PXCA("ENCOUNTER"))
SET IBX=PXCA("ENCOUNTER")
Begin DoDot:1
+23 IF $PIECE(IBX,"^",14)
SET X="Checkout Date/Time: "_$$FMTE^XLFDT($PIECE(IBX,"^",14))
DO NEWLINE(.RESULT,X,.LCNT)
+24 IF $PIECE(IBX,"^",4)
SET X=$SELECT($PIECE(IBX,"^",15)="P":"Primary ",$PIECE(IBX,"^",15)="S":"Secondary ",1:"")_"Provider: "_$PIECE($GET(^VA(200,+$PIECE(IBX,"^",4),0)),"^")
DO NEWLINE(.RESULT,X,.LCNT)
+25 ;; --change to api cpt ; dhh
+26 IF $PIECE(IBX,"^",5)
SET X=$PIECE(IBX,"^",5)
Begin DoDot:2
+27 IF X'=""
Begin DoDot:3
+28 NEW IBVST
+29 SET X=$$CPT^ICPTCOD(X)
+30 SET (X,IBVST)=$SELECT(+X=-1:"",1:$PIECE(X,"^",2))
+31 SET X="Visit Type CPT: "_X
DO NEWLINE(.RESULT,X,.LCNT)
+32 IF $DATA(PXCA("ENCOUNTER","MODIFIER"))
Begin DoDot:4
+33 SET X=" Modifier(s): "
DO NEWLINE(.RESULT,X,.LCNT)
+34 NEW IBM
SET IBM=0
+35 FOR
SET IBM=$ORDER(PXCA("ENCOUNTER","MODIFIER",IBM))
if IBM']""
QUIT
Begin DoDot:5
+36 NEW IBMDESC
SET IBMDESC=$$MODP^ICPTMOD(IBVST,IBM,"E")
if +IBMDESC<0
QUIT
+37 SET X=" "_IBM_"-"_$PIECE(IBMDESC,"^",2)
+38 DO NEWLINE(.RESULT,X,.LCNT)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+39 ; add sc,ao,ir,ec,mst,eligibility,credit stop (pieces 6-10,13,17)
+40 IF $PIECE(IBX,"^",6)
DO NEWLINE(.RESULT,"Visit for SC Condition",.LCNT)
+41 IF $PIECE(IBX,"^",7)
DO NEWLINE(.RESULT,"Visit for Agent Orange Condition",.LCNT)
+42 IF $PIECE(IBX,"^",8)
DO NEWLINE(.RESULT,"Visit for Ionizing Radiation Condition",.LCNT)
+43 IF $PIECE(IBX,"^",9)
DO NEWLINE(.RESULT,"Visit for Environmental Contaminates Condition",.LCNT)
+44 IF $PIECE(IBX,"^",10)
DO NEWLINE(.RESULT,"Visit for MST",.LCNT)
+45 IF $PIECE(IBX,"^",13)
DO NEWLINE(.RESULT,"Eligibility for Visit: "_$PIECE($GET(^DIC(8,+$PIECE(IBX,"^",13),0)),"^"),.LCNT)
+46 IF $PIECE(IBX,"^",17)
DO NEWLINE(.RESULT,"Additional Credit Stop: "_$PIECE($GET(^DIC(40.7,+$PIECE(IBX,"^",17),0)),"^"),.LCNT)
End DoDot:1
+47 ;
+48 ; -- expand the other nodes
+49 FOR M="DIAGNOSIS/PROBLEM","PROVIDER","DIAGNOSIS","PROCEDURE","VITALS","PROBLEM","EXAM","IMMUNIZATION","HEALTH FACTORS","SKIN TEST","PATIENT ED","LOCAL"
IF $DATA(PXCA(M))
Begin DoDot:1
+50 SET I=""
FOR
SET I=$ORDER(PXCA(M,I))
if I=""
QUIT
if M="PROVIDER"
DO PROV
SET J=""
FOR
SET J=$ORDER(PXCA(M,I,J))
if J=""
QUIT
Begin DoDot:2
+51 KILL X
SET IBX=PXCA(M,I,J)
Begin DoDot:3
+52 ;
+53 IF M="DIAGNOSIS"
SET X=$SELECT($PIECE(IBX,"^",2)="P":"Primary",$PIECE(IBX,"^",2)="S":"Secondary",1:"")_" Diagnosis: "_$PIECE($GET(^ICD9(+$PIECE($GET(IBX),"^"),0)),"^")_" - "_$PIECE(IBX,"^",9)_" - "_$PIECE(IBX,"^",8)
QUIT
+54 ;
+55 IF M="PROCEDURE"
Begin DoDot:4
+56 IF +IBX
Begin DoDot:5
+57 SET X=$$CPT^ICPTCOD(+IBX)
+58 SET X=$SELECT(X=-1:"",1:$PIECE(X,"^",2))
+59 SET X="Procedure: "_X_" - "_$PIECE(IBX,"^",7)_" - "_$PIECE(IBX,"^",6)_" - "_$SELECT($PIECE(IBX,"^",2)="P":"Primary ",$PIECE(IBX,"^",2)="S":"Secondary ",1:"Quantity: "_+$PIECE(IBX,"^",2))
+60 QUIT
End DoDot:5
+61 IF 'IBX
SET X="Treatment: "_$PIECE(IBX,"^",6)
End DoDot:4
+62 ;
+63 IF M="VITALS"
SET X="Vital Sign: "_$$VTYPE($PIECE(IBX,"^"))_": "_$PIECE(IBX,"^",2)
QUIT
+64 ;
+65 IF M="IMMUNIZATION"
SET X="Immunization: "_$$DSPLYIM^PXAPIIB(+IBX)
IF $PIECE(IBX,"^",5)
SET X=X_" - Contraindicated"
QUIT
+66 ;
+67 IF M="EXAM"
SET X="Exam: "_$$DSPLYEX^PXAPIIB(+IBX)_$SELECT($PIECE(IBX,"^",2)="A":" Abnormal",$PIECE(IBX,"^",2)="N":" Normal",1:"")
QUIT
+68 ;
+69 IF M="PROBLEM"
SET X="Problem List: "_$PIECE(IBX,"^")
QUIT
+70 ;
+71 IF M="HEALTH FACTORS"
SET X="Health Factor: "_$$DSPLYHF^PXAPIIB(+IBX)
NEW Y
SET Y=$PIECE(IBX,"^",2)
IF Y'=""
SET X=X_" Level/Severity: "_$SELECT(Y="M":"Minimal",Y="MO":"Moderate",Y="H":"Heavy/Severe",1:"")
QUIT
+72 ;
+73 IF M="SKIN TEST"
SET X="Skin Tests: "_$$DSPLYSK^PXAPIIB(+IBX)
QUIT
+74 ;
+75 IF M="PATIENT ED"
SET X="Patient Eduction: "_$$DSPLYED^PXAPIIB(+IBX)
IF $PIECE(IBX,"^",2)
SET X=X_" , Level of Understanding: "_$SELECT(IBX=1:"Poor",IBX=2:"Fair",IBX=3:"Good",IBX=4:"N/A",IBX=5:"Refused",1:"")
QUIT
+76 ;
+77 IF M="DIAGNOSIS/PROBLEM"
Begin DoDot:4
+78 NEW Y
SET X=""
+79 SET Y=$PIECE(IBX,"^",2)
SET X=$SELECT(Y="P":"Primary ",Y="S":"Secondary ",1:"")_"Diagnosis/Problem"
+80 ;I $P(IBX,"^",4) S X=X_$S($P(IBX,"^",6)="I":", Inactive",1:", Active")
+81 IF $PIECE(IBX,"^",13)'=""
SET X=X_" '"_$PIECE(IBX,"^",14)_$SELECT($PIECE(IBX,"^",14)'="":" ",1:"")_$PIECE(IBX,"^",13)_"'"
+82 ;I +$P(IBX,"^",3) S X=X_", Clinical Lexicon term: "_$P($G(^GMP(757.01,+$P(IBX,"^",3),0)),"^") ;clinical lexicon term passed
+83 IF +$PIECE(IBX,"^",3)
SET X=X_", Clinical Lexicon term: "
Begin DoDot:5
+84 IF $DATA(^LEX)
SET X=X_$PIECE($GET(^LEX(757.01,+$PIECE(IBX,"^",3),0)),"^")
QUIT
+85 SET X=X_$PIECE($GET(^GMP(757.01,+$PIECE(IBX,"^",3),0)),"^")
End DoDot:5
+86 IF $PIECE(IBX,"^",5)
SET X=X_", Added to Problem List "
+87 ;problem entry passed
IF +$PIECE(IBX,"^",4)
SET X=X_", Patient Active Problem: "_$$PROBNAR($PIECE(IBX,"^",4))
+88 IF +IBX
SET IBY=$PIECE($GET(^ICD9(+IBX,0)),"^")
IF IBX'[IBY
SET X=X_", ICD9: "_IBY
+89 IF $PIECE(IBX,"^",9)
SET X=X_" SC Condition "
+90 IF $PIECE(IBX,"^",10)
SET X=X_" AO Condition "
+91 IF $PIECE(IBX,"^",11)
SET X=X_" IR Condition "
+92 IF $PIECE(IBX,"^",12)
SET X=X_" EC Condition "
End DoDot:4
if X=""
SET X="Diagnosis/Problem: unspecified"
+93 IF M="LOCAL"
SET X="Local Data Received: "_IBX
QUIT
End DoDot:3
if $DATA(X)
DO NEWLINE(.RESULT,X,.LCNT)
+94 IF M="PROCEDURE"
IF $DATA(PXCA(M,I,J))
DO MODLIST
End DoDot:2
End DoDot:1
LSTQ QUIT
+1 ;
MODLIST ; -- expand the modifiers filed
+1 NEW IBM,X
SET IBM=0
+2 SET X=" Modifier(s): "
DO NEWLINE(.RESULT,X,.LCNT)
+3 FOR
SET IBM=$ORDER(PXCA(M,I,J,IBM))
if IBM']""
QUIT
Begin DoDot:1
+4 SET X=" "_IBM_"-"_$PIECE(PXCA(M,I,J,IBM),"^",3)
+5 DO NEWLINE(.RESULT,X,.LCNT)
End DoDot:1
+6 QUIT
PROV ; -- expand the additional provider node
+1 SET IBX=$GET(PXCA(M,I))
+2 SET X=$SELECT($EXTRACT(IBX,1)="P":"Primary ",$EXTRACT(IBX,1)="S":"Secondary ",1:"")_"Provider: "_$PIECE($GET(^VA(200,I,0)),"^")_$SELECT($PIECE(IBX,"^",2)=1:" Attending",1:"")
+3 DO NEWLINE(.RESULT,X,.LCNT)
+4 QUIT
+5 ;
NEWLINE(RESULT,X,LCNT) ;
+1 ; -- increment count and add new line to results array.
+2 SET LCNT=LCNT+1
+3 SET RESULT(LCNT)=X
+4 QUIT
+5 ;
VTYPE(X) ;
+1 ; -- Vital sign type from codes
+2 SET X=$GET(X)
+3 QUIT $SELECT(X="BP":"Blood Pressure",X="HT":"Height",X="WT":"Weight",X="TMP":"Temperature",X="PU":"Pulse",1:"Other Vital")
+4 ;
PROBNAR(IEN) ; -- display problem narrative
+1 ;
+2 QUIT $PIECE($GET(^AUTNPOV(+$PIECE($GET(^AUPNPROB(+$GET(IEN),0)),"^",5),0)),"^")
+3 ;
PROBDIA(IEN) ; -- return problem diagnosis code pointer
+1 QUIT +$PIECE($GET(^AUPNPROB(+$GET(IEN),0)),"^")
