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

IBDFRPC6.m

Go to the documentation of this file.
  1. IBDFRPC6 ;ALB/AAS - AICS Pass data to PCE, Broker Call ; 24-FEB-96
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;**3,25,38**;APR 24, 1997
  1. ;
  1. FINDALL(RESULT) ; -- loop through all entries for data
  1. ; -- called from ibdfrpc5, ONLY call if data in ^tmp
  1. N IBDI
  1. S RESULT(0)="The following data was found: "
  1. F IBDI="VST","PRV","POV","CPT","HF","PED","XAM","SK","IMM","TRT" D @(IBDI)
  1. K ^TMP("PXKENC",$J)
  1. Q
  1. ;
  1. PRV ; -- Expand Provider Entry
  1. N IBDY,IBDJ,IEN,X,Y
  1. F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
  1. .S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"PRV",IEN)) Q:'IEN D
  1. ..D GETY(.Y,IBDY,"PRV",IEN)
  1. ..I $G(IBDATA("UNFORMAT")) D
  1. ...S X=$S($P(Y,"^",4)="P":"Primary",1:"Secondary")_"^Provider^"_$P($G(^VA(200,+Y,0)),"^")
  1. ...S $P(X,"^",5)=$$SOURCE(9000010.06)
  1. ..I '$G(IBDATA("UNFORMAT")) D
  1. ...S X=$S($P(Y,"^",4)="P":" Primary",1:" Secondary")_" Provider: "_$P($G(^VA(200,+Y,0)),"^")
  1. ..D INC(X,.CNT)
  1. Q
  1. ;
  1. POV ; -- Expand POV entry, (9000010.07)
  1. N IBDY,IBDJ,IEN,X,Y
  1. F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
  1. .S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"POV",IEN)) Q:'IEN D
  1. ..D GETY(.Y,IBDY,"POV",IEN)
  1. ..I '$G(IBDATA("UNFORMAT")) D
  1. ...S X=$S($P(Y,"^",12)="P":" Primary",1:"Secondary")_" Diagnosis: "
  1. ...S X=X_$E($P($G(^ICD9(+Y,0)),"^")_" ",1,6)_" - "
  1. ...IF $P(Y,"^",4) S X=X_$$EXTERNAL^DILFD(9000010.07,.04,"",$P(Y,"^",4))
  1. ...ELSE S X=X_$E($G(^ICD9(+Y,1)),1,80)
  1. ..;
  1. ..I $G(IBDATA("UNFORMAT")) D
  1. ...S X=$S($P(Y,"^",12)="P":"Primary",1:"Secondary")_"^Diagnosis^"
  1. ...IF $P(Y,"^",4) S X=X_$$EXTERNAL^DILFD(9000010.07,.04,"",$P(Y,"^",4))
  1. ...ELSE S X=X_$E($G(^ICD9(+Y,1)),1,80)
  1. ...S X=X_"^"_$E($P($G(^ICD9(+Y,0)),"^")_" ",1,6)
  1. ...S $P(X,"^",5)=$$SOURCE(9000010.07)
  1. ..D INC(X,.CNT)
  1. Q
  1. ;
  1. CPT ; -- Expand CPT entry
  1. N IBDY,IBDJ,IEN,QUAN,X,Y,CODE
  1. F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
  1. .S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"CPT",IEN)) Q:'IEN D
  1. ..D GETY(.Y,IBDY,"CPT",IEN)
  1. ..S QUAN=$P(Y,"^",16)
  1. ..;;-----change to api cpt; dhh
  1. ..S CODE=$$CPT^ICPTCOD(+Y)
  1. ..I '$G(IBDATA("UNFORMAT")) D
  1. ...I +CODE=-1 S CODE=""
  1. ...E S CODE=$P(CODE,U,2)
  1. ...S X=" Procedure: "_CODE_" - "
  1. ...IF $P(Y,"^",4) S X=X_$$EXTERNAL^DILFD(9000010.18,.04,"",$P(Y,"^",4))
  1. ...ELSE S X=X_$P(CODE,"^",3)
  1. ...S X=X_" Quantity: "_QUAN
  1. ..I $G(IBDATA("UNFORMAT")) D
  1. ...S X="^Procedure^"
  1. ...IF $P(Y,"^",4) S X=X_$$EXTERNAL^DILFD(9000010.18,.04,"",$P(Y,"^",4))
  1. ...ELSE S X=X_$P(CODE,"^",3)
  1. ...S X=X_"^"_$P(CODE,"^",2)_"^"_$$SOURCE(9000010.18)_"^"_QUAN
  1. ..D INC(X,.CNT)
  1. Q
  1. ;
  1. HF ; -- Expand Health Factors
  1. N IBDY,IBDJ,IEN,X,Y,Z
  1. F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
  1. .S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"HF",IEN)) Q:'IEN D
  1. ..D GETY(.Y,IBDY,"HF",IEN)
  1. ..I '$G(IBDATA("UNFORMAT")) D
  1. ...S X=" Health Factor: "_$E($$EXTERNAL^DILFD(9000010.23,.01,"",+Y)_L,1,25)
  1. ...I $P(Y,"^",4)'="" S X=X_" Severity="_$$EXTERNAL^DILFD(9000010.23,.04,"",$P(Y,"^",4))
  1. ..;
  1. ..I $G(IBDATA("UNFORMAT")) D
  1. ...S X=""
  1. ...I $P(Y,"^",4)'="" S X=$$EXTERNAL^DILFD(9000010.23,.04,"",$P(Y,"^",4))
  1. ...S X=X_"^Health Factor^"_$E($$EXTERNAL^DILFD(9000010.23,.01,"",+Y),1,25)
  1. ...S $P(X,"^",5)=$$SOURCE(9000010.23)
  1. ..D INC(X,.CNT)
  1. Q
  1. ;
  1. IMM ; -- Expand Immunizations
  1. N IBDY,IBDJ,IEN,X,Y
  1. F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
  1. .S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"IMM",IEN)) Q:'IEN D
  1. ..D GETY(.Y,IBDY,"IMM",IEN)
  1. ..I '$G(IBDATA("UNFORMAT")) D
  1. ...S X=" Immunization: "_$$EXTERNAL^DILFD(9000010.11,.01,"",+Y)
  1. ...I $P(Y,"^",7) S X=X_" Contraindicated!"
  1. ..;
  1. ..I $G(IBDATA("UNFORMAT")) D
  1. ...S X="" I $P(Y,"^",7) S X="Contraindicated"
  1. ...S X=X_"^Immunization^"_$$EXTERNAL^DILFD(9000010.11,.01,"",+Y)
  1. ...S $P(X,"^",5)=$$SOURCE(9000010.11)
  1. ..D INC(X,.CNT)
  1. Q
  1. ;
  1. PED ; -- Expand Patient Education
  1. N IBDY,IBDJ,IEN,X,Y
  1. F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
  1. .S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"PED",IEN)) Q:'IEN D
  1. ..D GETY(.Y,IBDY,"PED",IEN)
  1. ..I '$G(IBDATA("UNFORMAT")) D
  1. ...S X=" Education Topic: "_$E($$EXTERNAL^DILFD(9000010.16,.01,"",+Y)_L,1,25)
  1. ...I $P(Y,"^",6)'="" S X=X_" Understanding="_$$EXTERNAL^DILFD(9000010.16,.06,"",$P(Y,"^",6))
  1. ..;
  1. ..I $G(IBDATA("UNFORMAT")) D
  1. ...S X=""
  1. ...I $P(Y,"^",6)'="" S X=$$EXTERNAL^DILFD(9000010.16,.06,"",$P(Y,"^",6))
  1. ...S X=X_"^Education Topic^"_$E($$EXTERNAL^DILFD(9000010.16,.01,"",+Y),1,25)
  1. ...S $P(X,"^",5)=$$SOURCE(9000010.16)
  1. ..D INC(X,.CNT)
  1. Q
  1. ;
  1. SK ; -- Expand Skin Tests
  1. N IBDY,IBDJ,IEN,X,Y,Z
  1. F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
  1. .S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"SK",IEN)) Q:'IEN D
  1. ..D GETY(.Y,IBDY,"SK",IEN)
  1. ..I '$G(IBDATA("UNFORMAT")) D
  1. ...S X=" Skin Test: "_$E($$EXTERNAL^DILFD(9000010.12,.01,"",+Y)_L,1,25)
  1. ...I $P(Y,"^",4)'="" S X=X_" Result="_$$EXTERNAL^DILFD(9000010.12,.04,"",$P(Y,"^",4))
  1. ..;
  1. ..I $G(IBDATA("UNFORMAT")) D
  1. ...S X=$$EXTERNAL^DILFD(9000010.12,.04,"",$P(Y,"^",4))
  1. ...S X=X_"^Skin Test^"_$E($$EXTERNAL^DILFD(9000010.12,.01,"",+Y),1,25)
  1. ...S $P(X,"^",5)=$$SOURCE(9000010.12)
  1. ..D INC(X,.CNT)
  1. Q
  1. ;
  1. TRT ; -- Expand Treatments
  1. N IBDY,IBDJ,IEN,X,Y,TRT
  1. F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
  1. .S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"TRT",IEN)) Q:'IEN D
  1. ..D GETY(.Y,IBDY,"TRT",IEN)
  1. ..S TRT=$$EXTERNAL^DILFD(9000010.15,.01,"",+Y)
  1. ..I TRT="OTHER" S TRT=$$EXTERNAL^DILFD(9000010.15,.06,"",$P(Y,"^",6))
  1. ..I '$G(IBDATA("UNFORMAT")) D
  1. ...S X=" Treatment: "_TRT
  1. ..I $G(IBDATA("UNFORMAT")) D
  1. ...S X="^Treatment^"_TRT
  1. ...S $P(X,"^",5)=$$SOURCE(9000010.15)
  1. ..D INC(X,.CNT)
  1. Q
  1. ;
  1. XAM ; -- Expand Exams
  1. N IBDY,IBDJ,IEN,X,Y
  1. F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
  1. .S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"XAM",IEN)) Q:'IEN D
  1. ..D GETY(.Y,IBDY,"XAM",IEN)
  1. ..I '$G(IBDATA("UNFORMAT")) D
  1. ...S X=" Exam: "_$E($$EXTERNAL^DILFD(9000010.13,.01,"",+Y)_L,1,25)
  1. ...S X=X_" Result="_$$EXTERNAL^DILFD(9000010.13,.04,"",$P(Y,"^",4))
  1. ..;
  1. ..I $G(IBDATA("UNFORMAT")) D
  1. ...S X=$$EXTERNAL^DILFD(9000010.13,.04,"",$P(Y,"^",4))
  1. ...S X=X_"^Exam^"_$E($$EXTERNAL^DILFD(9000010.13,.01,"",+Y),1,25)
  1. ...S $P(X,"^",5)=$$SOURCE(9000010.13)
  1. ..D INC(X,.CNT)
  1. Q
  1. ;
  1. VST ; -- Expand visit entry
  1. N IBDY,IBDJ,IBDZ,IEN,X,Y
  1. F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
  1. .S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"VST",IEN)) Q:'IEN D
  1. ..D GETY(.Y,IBDY,"VST",IEN)
  1. ..I '$G(IBDATA("UNFORMAT")) D
  1. ...S X=" Encounter Info: "_$$EXTERNAL^DILFD(9000010,.22,"",$P(Y,"^",22))_" - "_$$FMTE^XLFDT(+Y)_" - "_$$EXTERNAL^DILFD(9000010,15003,"",$P(Y(150),"^",3))_" Encounter"
  1. ...D INC(X,.CNT)
  1. ...S X=""
  1. ...S X=$$SOURCE(9000010) I X'="" S X=$E(L,1,22)_"Source - "_X
  1. ...I $P(Y(800),"^",1)'="" S X=X_", SC := "_$S($P(Y(800),"^",1):"Yes",1:"No")
  1. ...I $P(Y(800),"^",2)'="" S X=X_", AO:="_$S($P(Y(800),"^",2):"Yes",1:"No")
  1. ...I $P(Y(800),"^",3)'="" S X=X_", IR:="_$S($P(Y(800),"^",3):"Yes",1:"No")
  1. ...I $P(Y(800),"^",4)'="" S X=X_", EC:="_$S($P(Y(800),"^",4):"Yes",1:"No")
  1. ..;
  1. ..I $G(IBDATA("UNFORMAT")) D
  1. ...S X=$$EXTERNAL^DILFD(9000010,15003,"",$P(Y(150),"^",3))_"^Encounter^"
  1. ...S X=X_$$EXTERNAL^DILFD(9000010,.22,"",$P(Y,"^",22))_"^"_$$FMTE^XLFDT(+Y)_"^"
  1. ...S X=X_$$SOURCE(9000010)
  1. ...F IBDZ=1:1:4 I $P(Y(800),"^",IBDZ)'="" S $P(X,"^",(6+IBDZ))=$P(Y(800),"^",IBDZ)
  1. ..I X'="" D INC(X,.CNT)
  1. Q
  1. ;
  1. INC(X,CNT) ; -- increment results array
  1. S CNT=CNT+1
  1. S RESULT(CNT)=X
  1. Q
  1. ;
  1. GETY(Y,IBDY,TYPE,IEN) ; -- return y array
  1. S Y=$G(^TMP("PXKENC",$J,IBDY,TYPE,IEN,0))
  1. S Y(150)=$G(^TMP("PXKENC",$J,IBDY,TYPE,IEN,150))
  1. S Y(812)=$G(^TMP("PXKENC",$J,IBDY,TYPE,IEN,812))
  1. I TYPE="VST" S Y(800)=$G(^TMP("PXKENC",$J,IBDY,TYPE,IEN,800))
  1. Q
  1. ;
  1. SOURCE(FILE) ; -- return source of data
  1. N X S X=""
  1. I $P(Y(812),"^",3)'="" S X=$$EXTERNAL^DILFD(FILE,81203,"",$P(Y(812),"^",3))
  1. I X="",$P(Y(812),"^",2)'="" S X=$$EXTERNAL^DILFD(FILE,81202,"",$P(Y(812),"^",2))
  1. Q X
  1. ;
  1. TEST G TEST^IBDFRPC5
  1. TESTW G TESTW^IBDFRPC5