Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACDRLU2

ACDRLU2.m

Go to the documentation of this file. 
  1. ACDRLU2 ;IHS/ADC/EDE/KML - UTILITY ROUTINE;
  1.  ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
  1.  ;
  1. DATA(V,F,F1,F2) ;EP - get data item
  1.  I $G(F)="" S F="E"
  1.  NEW %,I
  1.  S %=""
  1.  I $G(F1)="" Q %
  1.  I $G(F2)="" Q %
  1.  I $D(^ACDIIF("C",V)) D  Q %
  1.  .S I=$O(^ACDIIF("C",V,0))
  1.  .S %=$S(F="I":$$VALI^XBDIQ1(9002170,I,F1),1:$$VAL^XBDIQ1(9002170,I,F1))
  1.  .Q
  1.  I $D(^ACDTDC("C",V)) D  Q %
  1.  .S I=$O(^ACDTDC("C",V,0))
  1.  .S %=$S(F="I":$$VALI^XBDIQ1(9002171,I,F2),1:$$VAL^XBDIQ1(9002171,I,F2))
  1.  .Q
  1.  Q %
  1. DRUG ;EP
  1.  K X
  1.  NEW %,I,%1
  1.  S %=""
  1.  I $D(^ACDIIF("C",ACDR)) D  Q
  1.  .S I=$O(^ACDIIF("C",ACDR,0))
  1.  .S %1=0 F  S %1=$O(^ACDIIF(I,2,%1)) Q:%1'=+%1  S X($P(^ACDIIF(I,2,%1,0),U))=""
  1.  .Q
  1.  I $D(^ACDTDC("C",ACDR)) D  Q
  1.  .S I=$O(^ACDTDC("C",ACDR,0))
  1.  .S %1=0 F  S %1=$O(^ACDTDC(I,2,%1)) Q:%1'=+%1  S X($P(^ACDTDC(I,2,%1,0),U))=""
  1.  .Q
  1.  Q
  1. DRUGP ;EP
  1.  K ACDPRNM
  1.  S ACDPCNT=0
  1.  NEW %,I,%1
  1.  S %=""
  1.  I $D(^ACDIIF("C",ACDR)) D  Q
  1.  .S I=$O(^ACDIIF("C",ACDR,0))
  1.  .S %1=0 F  S %1=$O(^ACDIIF(I,2,%1)) Q:%1'=+%1  S ACDPCNT=ACDPCNT+1,ACDPRNM(ACDPCNT)=$P(^ACDDRUG($P(^ACDIIF(I,2,%1,0),U),0),U)
  1.  .Q
  1.  I $D(^ACDTDC("C",ACDR)) D  Q
  1.  .S I=$O(^ACDTDC("C",ACDR,0))
  1.  .S %1=0 F  S %1=$O(^ACDTDC(I,2,%1)) Q:%1'=+%1  S ACDPCNT=ACDPCNT+1,ACDPRNM(ACDPCNT)=$P(^ACDDRUG($P(^ACDTDC(I,2,%1,0),U),0),U)
  1.  .Q
  1.  Q
  1. OTHPROB ;EP
  1.  K X
  1.  NEW %,I,%1
  1.  S %=""
  1.  I $D(^ACDIIF("C",ACDR)) D  Q
  1.  .S I=$O(^ACDIIF("C",ACDR,0))
  1.  .S %1=0 F  S %1=$O(^ACDIIF(I,3,%1)) Q:%1'=+%1  S X($P(^ACDIIF(I,3,%1,0),U))=""
  1.  .Q
  1.  I $D(^ACDTDC("C",ACDR)) D  Q
  1.  .S I=$O(^ACDTDC("C",ACDR,0))
  1.  .S %1=0 F  S %1=$O(^ACDTDC(I,3,%1)) Q:%1'=+%1  S X($P(^ACDTDC(I,3,%1,0),U))=""
  1.  .Q
  1.  Q
  1. OTHPROBP ;EP
  1.  K ACDPRNM
  1.  S ACDPCNT=0
  1.  NEW %,I,%1
  1.  S %=""
  1.  I $D(^ACDIIF("C",ACDR)) D  Q
  1.  .S I=$O(^ACDIIF("C",ACDR,0))
  1.  .S %1=0 F  S %1=$O(^ACDIIF(I,3,%1)) Q:%1'=+%1  S ACDPCNT=ACDPCNT+1,ACDPRNM(ACDPCNT)=$P(^ACDPROB($P(^ACDIIF(I,3,%1,0),U),0),U)
  1.  .Q
  1.  I $D(^ACDTDC("C",ACDR)) D  Q
  1.  .S I=$O(^ACDTDC("C",ACDR,0))
  1.  .S %1=0 F  S %1=$O(^ACDTDC(I,3,%1)) Q:%1'=+%1  S ACDPCNT=ACDPCNT+1,ACDPRNM(ACDPCNT)=$P(^ACDPROB($P(^ACDTDC(I,3,%1,0),U),0),U)
  1.  .Q
  1.  Q
  1. HOURS ;EP
  1.  K X
  1.  NEW %,I,%1
  1.  S %=""
  1.  I $D(^ACDIIF("C",ACDR)) D  Q
  1.  .S I=$O(^ACDIIF("C",ACDR,0))
  1.  .S X=$$VALI^XBDIQ1(9002170,I,102) I X S X(X)=""
  1.  .Q
  1.  I $D(^ACDTDC("C",ACDR)) D  Q
  1.  .S I=$O(^ACDTDC("C",ACDR,0))
  1.  .S X=$$VALI^XBDIQ1(9002171,I,29) I X S X(X)=""
  1.  .Q
  1.  I $D(^ACDCS("C",ACDR)) D
  1.  .S I=0 F  S I=$O(^ACDCS("C",ACDR,I)) Q:I'=+I  S Y=$$VALI^XBDIQ1(9002172,I,3) I Y S X(Y)=""
  1. HOURSP ;EP
  1.  K X
  1.  NEW %,I,%1
  1.  S %=""
  1.  I $D(^ACDIIF("C",ACDR)) D  Q
  1.  .S I=$O(^ACDIIF("C",ACDR,0))
  1.  .S X=$$VAL^XBDIQ1(9002170,I,102) I X S ACDPRNM(1)=X
  1.  .Q
  1.  I $D(^ACDTDC("C",ACDR)) D  Q
  1.  .S I=$O(^ACDTDC("C",ACDR,0))
  1.  .S X=$$VAL^XBDIQ1(9002171,I,29) I X S ACDPRNM(1)=X
  1.  .Q
  1.  I $D(^ACDCS("C",ACDR)) D
  1.  .S I=0 F  S I=$O(^ACDCS("C",ACDR,I)) Q:I'=+I  S Y=$$VAL^XBDIQ1(9002172,I,3) I Y S ACDPCNT=ACDPCNT+1,ACDPRNM(ACDPCNT)=Y
  1.  Q
  1. PPPROB ;EP - called from patient lister
  1.  ;sets X(ien of problem) equal to all primary problems this patient
  1.  ;had between ACDBD and ACDED (beginning and ending dates)
  1.  Q:'$G(DFN)  ;no patient passed
  1.  K X
  1.  NEW Y,V,I
  1.  S V=0 F  S V=$O(^ACDVIS("D",DFN,V)) Q:V'=+V  S I=$P($P(^ACDVIS(V,0),U),".") I I'<ACDBD,I'>ACDED D
  1.  .S Y=0 F  S Y=$O(^ACDIIF("C",V,Y)) Q:Y'=+Y  S X($P(^ACDIIF(Y,0),U))=""
  1.  Q
  1. PAPROB ;EP - called from patient list
  1.  ;sets X(ien of problem) equal to all other problems this patient
  1.  ;had between ACDBD and ACDED (beginning and ending dates)
  1.  Q:'$G(DFN)  ;no patient passed
  1.  K X
  1.  NEW Y,V,I,A,B
  1.  S V=0 F  S V=$O(^ACDVIS("D",DFN,V)) Q:V'=+V  S I=$P($P(^ACDVIS(V,0),U),".") I I'<ACDBD,I'>ACDED D
  1.  .S I=0 F   S I=$O(^ACDIIF("C",V,I)) Q:I'=+I  D
  1.  ..S %=0 F  S %=$O(^ACDIIF(I,3,%)) Q:%'=+%  S X($P(^ACDIIF(I,3,%,0),U))=""
  1.  .S I=0 F  S I=$O(^ACDTDC("C",ACDR,I)) Q:I'=+I  D
  1.  ..S %=0 F  S %=$O(^ACDTDC(I,3,%)) Q:%'=+%  S X($P(^ACDTDC(I,3,%,0),U))=""
  1.  Q
  1. PPPROV ;EP - called from patient lister
  1.  ;sets X(ien of problem) equal to all primary providers this patient
  1.  ;had between ACDBD and ACDED (beginning and ending dates)
  1.  Q:'$G(DFN)  ;no patient passed
  1.  K X
  1.  NEW Y,V,I
  1.  S V=0 F  S V=$O(^ACDVIS("D",DFN,V)) Q:V'=+V  S I=$P($P(^ACDVIS(V,0),U),".") I I'<ACDBD,I'>ACDED I $P(^ACDVIS(V,0),U,3) S X($P(^ACDVIS(V,0),U,3))=""
  1.  Q
  1. PCOMPC ;EP
  1.  ;sets X(ien of problem) equal to all components this patient
  1.  ;had between ACDBD and ACDED (beginning and ending dates)
  1.  Q:'$G(DFN)  ;no patient passed
  1.  K X
  1.  NEW Y,V,I
  1.  S V=0 F  S V=$O(^ACDVIS("D",DFN,V)) Q:V'=+V  S I=$P($P(^ACDVIS(V,0),U),".") I I'<ACDBD,I'>ACDED I $P(^ACDVIS(V,0),U,2)]"" S X($P(^ACDVIS(V,0),U,2))=""
  1.  Q
  1. PCOMPT ;EP
  1.  ;sets X(ien of problem) equal to all component types this patient
  1.  ;had between ACDBD and ACDED (beginning and ending dates)
  1.  Q:'$G(DFN)  ;no patient passed
  1.  K X
  1.  NEW Y,V,I
  1.  S V=0 F  S V=$O(^ACDVIS("D",DFN,V)) Q:V'=+V  S I=$P($P(^ACDVIS(V,0),U),".") I I'<ACDBD,I'>ACDED I $P(^ACDVIS(V,0),U,7)]"" S X($P(^ACDVIS(V,0),U,7))=""
  1.  Q
  1. PDRUG ;EP
  1.  ;sets X(ien of problem) equal to all drug types this patient
  1.  ;had between ACDBD and ACDED (beginning and ending dates)
  1.  Q:'$G(DFN)  ;no patient passed
  1.  K X
  1.  NEW Y,V,I,A,B
  1.  S V=0 F  S V=$O(^ACDVIS("D",DFN,V)) Q:V'=+V  S I=$P($P(^ACDVIS(V,0),U),".") I I'<ACDBD,I'>ACDED D
  1.  .S I=0 F   S I=$O(^ACDIIF("C",V,I)) Q:I'=+I  D
  1.  ..S %=0 F  S %=$O(^ACDIIF(I,2,%)) Q:%'=+%  S X($P(^ACDIIF(I,2,%,0),U))=""
  1.  .S I=0 F  S I=$O(^ACDTDC("C",ACDR,I)) Q:I'=+I  D
  1.  ..S %=0 F  S %=$O(^ACDTDC(I,2,%)) Q:%'=+%  S X($P(^ACDTDC(I,2,%,0),U))=""
  1.  Q