IBDFRPC6 ;ALB/AAS - AICS Pass data to PCE, Broker Call ; 24-FEB-96
;;3.0;AUTOMATED INFO COLLECTION SYS;**3,25,38**;APR 24, 1997
;
FINDALL(RESULT) ; -- loop through all entries for data
; -- called from ibdfrpc5, ONLY call if data in ^tmp
N IBDI
S RESULT(0)="The following data was found: "
F IBDI="VST","PRV","POV","CPT","HF","PED","XAM","SK","IMM","TRT" D @(IBDI)
K ^TMP("PXKENC",$J)
Q
;
PRV ; -- Expand Provider Entry
N IBDY,IBDJ,IEN,X,Y
F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
.S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"PRV",IEN)) Q:'IEN D
..D GETY(.Y,IBDY,"PRV",IEN)
..I $G(IBDATA("UNFORMAT")) D
...S X=$S($P(Y,"^",4)="P":"Primary",1:"Secondary")_"^Provider^"_$P($G(^VA(200,+Y,0)),"^")
...S $P(X,"^",5)=$$SOURCE(9000010.06)
..I '$G(IBDATA("UNFORMAT")) D
...S X=$S($P(Y,"^",4)="P":" Primary",1:" Secondary")_" Provider: "_$P($G(^VA(200,+Y,0)),"^")
..D INC(X,.CNT)
Q
;
POV ; -- Expand POV entry, (9000010.07)
N IBDY,IBDJ,IEN,X,Y
F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
.S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"POV",IEN)) Q:'IEN D
..D GETY(.Y,IBDY,"POV",IEN)
..I '$G(IBDATA("UNFORMAT")) D
...S X=$S($P(Y,"^",12)="P":" Primary",1:"Secondary")_" Diagnosis: "
...S X=X_$E($P($G(^ICD9(+Y,0)),"^")_" ",1,6)_" - "
...IF $P(Y,"^",4) S X=X_$$EXTERNAL^DILFD(9000010.07,.04,"",$P(Y,"^",4))
...ELSE S X=X_$E($G(^ICD9(+Y,1)),1,80)
..;
..I $G(IBDATA("UNFORMAT")) D
...S X=$S($P(Y,"^",12)="P":"Primary",1:"Secondary")_"^Diagnosis^"
...IF $P(Y,"^",4) S X=X_$$EXTERNAL^DILFD(9000010.07,.04,"",$P(Y,"^",4))
...ELSE S X=X_$E($G(^ICD9(+Y,1)),1,80)
...S X=X_"^"_$E($P($G(^ICD9(+Y,0)),"^")_" ",1,6)
...S $P(X,"^",5)=$$SOURCE(9000010.07)
..D INC(X,.CNT)
Q
;
CPT ; -- Expand CPT entry
N IBDY,IBDJ,IEN,QUAN,X,Y,CODE
F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
.S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"CPT",IEN)) Q:'IEN D
..D GETY(.Y,IBDY,"CPT",IEN)
..S QUAN=$P(Y,"^",16)
..;;-----change to api cpt; dhh
..S CODE=$$CPT^ICPTCOD(+Y)
..I '$G(IBDATA("UNFORMAT")) D
...I +CODE=-1 S CODE=""
...E S CODE=$P(CODE,U,2)
...S X=" Procedure: "_CODE_" - "
...IF $P(Y,"^",4) S X=X_$$EXTERNAL^DILFD(9000010.18,.04,"",$P(Y,"^",4))
...ELSE S X=X_$P(CODE,"^",3)
...S X=X_" Quantity: "_QUAN
..I $G(IBDATA("UNFORMAT")) D
...S X="^Procedure^"
...IF $P(Y,"^",4) S X=X_$$EXTERNAL^DILFD(9000010.18,.04,"",$P(Y,"^",4))
...ELSE S X=X_$P(CODE,"^",3)
...S X=X_"^"_$P(CODE,"^",2)_"^"_$$SOURCE(9000010.18)_"^"_QUAN
..D INC(X,.CNT)
Q
;
HF ; -- Expand Health Factors
N IBDY,IBDJ,IEN,X,Y,Z
F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
.S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"HF",IEN)) Q:'IEN D
..D GETY(.Y,IBDY,"HF",IEN)
..I '$G(IBDATA("UNFORMAT")) D
...S X=" Health Factor: "_$E($$EXTERNAL^DILFD(9000010.23,.01,"",+Y)_L,1,25)
...I $P(Y,"^",4)'="" S X=X_" Severity="_$$EXTERNAL^DILFD(9000010.23,.04,"",$P(Y,"^",4))
..;
..I $G(IBDATA("UNFORMAT")) D
...S X=""
...I $P(Y,"^",4)'="" S X=$$EXTERNAL^DILFD(9000010.23,.04,"",$P(Y,"^",4))
...S X=X_"^Health Factor^"_$E($$EXTERNAL^DILFD(9000010.23,.01,"",+Y),1,25)
...S $P(X,"^",5)=$$SOURCE(9000010.23)
..D INC(X,.CNT)
Q
;
IMM ; -- Expand Immunizations
N IBDY,IBDJ,IEN,X,Y
F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
.S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"IMM",IEN)) Q:'IEN D
..D GETY(.Y,IBDY,"IMM",IEN)
..I '$G(IBDATA("UNFORMAT")) D
...S X=" Immunization: "_$$EXTERNAL^DILFD(9000010.11,.01,"",+Y)
...I $P(Y,"^",7) S X=X_" Contraindicated!"
..;
..I $G(IBDATA("UNFORMAT")) D
...S X="" I $P(Y,"^",7) S X="Contraindicated"
...S X=X_"^Immunization^"_$$EXTERNAL^DILFD(9000010.11,.01,"",+Y)
...S $P(X,"^",5)=$$SOURCE(9000010.11)
..D INC(X,.CNT)
Q
;
PED ; -- Expand Patient Education
N IBDY,IBDJ,IEN,X,Y
F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
.S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"PED",IEN)) Q:'IEN D
..D GETY(.Y,IBDY,"PED",IEN)
..I '$G(IBDATA("UNFORMAT")) D
...S X=" Education Topic: "_$E($$EXTERNAL^DILFD(9000010.16,.01,"",+Y)_L,1,25)
...I $P(Y,"^",6)'="" S X=X_" Understanding="_$$EXTERNAL^DILFD(9000010.16,.06,"",$P(Y,"^",6))
..;
..I $G(IBDATA("UNFORMAT")) D
...S X=""
...I $P(Y,"^",6)'="" S X=$$EXTERNAL^DILFD(9000010.16,.06,"",$P(Y,"^",6))
...S X=X_"^Education Topic^"_$E($$EXTERNAL^DILFD(9000010.16,.01,"",+Y),1,25)
...S $P(X,"^",5)=$$SOURCE(9000010.16)
..D INC(X,.CNT)
Q
;
SK ; -- Expand Skin Tests
N IBDY,IBDJ,IEN,X,Y,Z
F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
.S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"SK",IEN)) Q:'IEN D
..D GETY(.Y,IBDY,"SK",IEN)
..I '$G(IBDATA("UNFORMAT")) D
...S X=" Skin Test: "_$E($$EXTERNAL^DILFD(9000010.12,.01,"",+Y)_L,1,25)
...I $P(Y,"^",4)'="" S X=X_" Result="_$$EXTERNAL^DILFD(9000010.12,.04,"",$P(Y,"^",4))
..;
..I $G(IBDATA("UNFORMAT")) D
...S X=$$EXTERNAL^DILFD(9000010.12,.04,"",$P(Y,"^",4))
...S X=X_"^Skin Test^"_$E($$EXTERNAL^DILFD(9000010.12,.01,"",+Y),1,25)
...S $P(X,"^",5)=$$SOURCE(9000010.12)
..D INC(X,.CNT)
Q
;
TRT ; -- Expand Treatments
N IBDY,IBDJ,IEN,X,Y,TRT
F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
.S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"TRT",IEN)) Q:'IEN D
..D GETY(.Y,IBDY,"TRT",IEN)
..S TRT=$$EXTERNAL^DILFD(9000010.15,.01,"",+Y)
..I TRT="OTHER" S TRT=$$EXTERNAL^DILFD(9000010.15,.06,"",$P(Y,"^",6))
..I '$G(IBDATA("UNFORMAT")) D
...S X=" Treatment: "_TRT
..I $G(IBDATA("UNFORMAT")) D
...S X="^Treatment^"_TRT
...S $P(X,"^",5)=$$SOURCE(9000010.15)
..D INC(X,.CNT)
Q
;
XAM ; -- Expand Exams
N IBDY,IBDJ,IEN,X,Y
F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
.S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"XAM",IEN)) Q:'IEN D
..D GETY(.Y,IBDY,"XAM",IEN)
..I '$G(IBDATA("UNFORMAT")) D
...S X=" Exam: "_$E($$EXTERNAL^DILFD(9000010.13,.01,"",+Y)_L,1,25)
...S X=X_" Result="_$$EXTERNAL^DILFD(9000010.13,.04,"",$P(Y,"^",4))
..;
..I $G(IBDATA("UNFORMAT")) D
...S X=$$EXTERNAL^DILFD(9000010.13,.04,"",$P(Y,"^",4))
...S X=X_"^Exam^"_$E($$EXTERNAL^DILFD(9000010.13,.01,"",+Y),1,25)
...S $P(X,"^",5)=$$SOURCE(9000010.13)
..D INC(X,.CNT)
Q
;
VST ; -- Expand visit entry
N IBDY,IBDJ,IBDZ,IEN,X,Y
F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:'IBDY D
.S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,IBDY,"VST",IEN)) Q:'IEN D
..D GETY(.Y,IBDY,"VST",IEN)
..I '$G(IBDATA("UNFORMAT")) D
...S X=" Encounter Info: "_$$EXTERNAL^DILFD(9000010,.22,"",$P(Y,"^",22))_" - "_$$FMTE^XLFDT(+Y)_" - "_$$EXTERNAL^DILFD(9000010,15003,"",$P(Y(150),"^",3))_" Encounter"
...D INC(X,.CNT)
...S X=""
...S X=$$SOURCE(9000010) I X'="" S X=$E(L,1,22)_"Source - "_X
...I $P(Y(800),"^",1)'="" S X=X_", SC := "_$S($P(Y(800),"^",1):"Yes",1:"No")
...I $P(Y(800),"^",2)'="" S X=X_", AO:="_$S($P(Y(800),"^",2):"Yes",1:"No")
...I $P(Y(800),"^",3)'="" S X=X_", IR:="_$S($P(Y(800),"^",3):"Yes",1:"No")
...I $P(Y(800),"^",4)'="" S X=X_", EC:="_$S($P(Y(800),"^",4):"Yes",1:"No")
..;
..I $G(IBDATA("UNFORMAT")) D
...S X=$$EXTERNAL^DILFD(9000010,15003,"",$P(Y(150),"^",3))_"^Encounter^"
...S X=X_$$EXTERNAL^DILFD(9000010,.22,"",$P(Y,"^",22))_"^"_$$FMTE^XLFDT(+Y)_"^"
...S X=X_$$SOURCE(9000010)
...F IBDZ=1:1:4 I $P(Y(800),"^",IBDZ)'="" S $P(X,"^",(6+IBDZ))=$P(Y(800),"^",IBDZ)
..I X'="" D INC(X,.CNT)
Q
;
INC(X,CNT) ; -- increment results array
S CNT=CNT+1
S RESULT(CNT)=X
Q
;
GETY(Y,IBDY,TYPE,IEN) ; -- return y array
S Y=$G(^TMP("PXKENC",$J,IBDY,TYPE,IEN,0))
S Y(150)=$G(^TMP("PXKENC",$J,IBDY,TYPE,IEN,150))
S Y(812)=$G(^TMP("PXKENC",$J,IBDY,TYPE,IEN,812))
I TYPE="VST" S Y(800)=$G(^TMP("PXKENC",$J,IBDY,TYPE,IEN,800))
Q
;
SOURCE(FILE) ; -- return source of data
N X S X=""
I $P(Y(812),"^",3)'="" S X=$$EXTERNAL^DILFD(FILE,81203,"",$P(Y(812),"^",3))
I X="",$P(Y(812),"^",2)'="" S X=$$EXTERNAL^DILFD(FILE,81202,"",$P(Y(812),"^",2))
Q X
;
TEST G TEST^IBDFRPC5
TESTW G TESTW^IBDFRPC5
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFRPC6 8027 printed Dec 13, 2024@02:53:24 Page 2
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
+2 ;
FINDALL(RESULT) ; -- loop through all entries for data
+1 ; -- called from ibdfrpc5, ONLY call if data in ^tmp
+2 NEW IBDI
+3 SET RESULT(0)="The following data was found: "
+4 FOR IBDI="VST","PRV","POV","CPT","HF","PED","XAM","SK","IMM","TRT"
DO @(IBDI)
+5 KILL ^TMP("PXKENC",$JOB)
+6 QUIT
+7 ;
PRV ; -- Expand Provider Entry
+1 NEW IBDY,IBDJ,IEN,X,Y
+2 FOR IBDJ=1:1
SET IBDY=$PIECE(ENCTRS,"^",IBDJ)
if 'IBDY
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("PXKENC",$JOB,IBDY,"PRV",IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 DO GETY(.Y,IBDY,"PRV",IEN)
+5 IF $GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+6 SET X=$SELECT($PIECE(Y,"^",4)="P":"Primary",1:"Secondary")_"^Provider^"_$PIECE($GET(^VA(200,+Y,0)),"^")
+7 SET $PIECE(X,"^",5)=$$SOURCE(9000010.06)
End DoDot:3
+8 IF '$GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+9 SET X=$SELECT($PIECE(Y,"^",4)="P":" Primary",1:" Secondary")_" Provider: "_$PIECE($GET(^VA(200,+Y,0)),"^")
End DoDot:3
+10 DO INC(X,.CNT)
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
POV ; -- Expand POV entry, (9000010.07)
+1 NEW IBDY,IBDJ,IEN,X,Y
+2 FOR IBDJ=1:1
SET IBDY=$PIECE(ENCTRS,"^",IBDJ)
if 'IBDY
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("PXKENC",$JOB,IBDY,"POV",IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 DO GETY(.Y,IBDY,"POV",IEN)
+5 IF '$GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+6 SET X=$SELECT($PIECE(Y,"^",12)="P":" Primary",1:"Secondary")_" Diagnosis: "
+7 SET X=X_$EXTRACT($PIECE($GET(^ICD9(+Y,0)),"^")_" ",1,6)_" - "
+8 IF $PIECE(Y,"^",4)
SET X=X_$$EXTERNAL^DILFD(9000010.07,.04,"",$PIECE(Y,"^",4))
+9 IF '$TEST
SET X=X_$EXTRACT($GET(^ICD9(+Y,1)),1,80)
End DoDot:3
+10 ;
+11 IF $GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+12 SET X=$SELECT($PIECE(Y,"^",12)="P":"Primary",1:"Secondary")_"^Diagnosis^"
+13 IF $PIECE(Y,"^",4)
SET X=X_$$EXTERNAL^DILFD(9000010.07,.04,"",$PIECE(Y,"^",4))
+14 IF '$TEST
SET X=X_$EXTRACT($GET(^ICD9(+Y,1)),1,80)
+15 SET X=X_"^"_$EXTRACT($PIECE($GET(^ICD9(+Y,0)),"^")_" ",1,6)
+16 SET $PIECE(X,"^",5)=$$SOURCE(9000010.07)
End DoDot:3
+17 DO INC(X,.CNT)
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
CPT ; -- Expand CPT entry
+1 NEW IBDY,IBDJ,IEN,QUAN,X,Y,CODE
+2 FOR IBDJ=1:1
SET IBDY=$PIECE(ENCTRS,"^",IBDJ)
if 'IBDY
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("PXKENC",$JOB,IBDY,"CPT",IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 DO GETY(.Y,IBDY,"CPT",IEN)
+5 SET QUAN=$PIECE(Y,"^",16)
+6 ;;-----change to api cpt; dhh
+7 SET CODE=$$CPT^ICPTCOD(+Y)
+8 IF '$GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+9 IF +CODE=-1
SET CODE=""
+10 IF '$TEST
SET CODE=$PIECE(CODE,U,2)
+11 SET X=" Procedure: "_CODE_" - "
+12 IF $PIECE(Y,"^",4)
SET X=X_$$EXTERNAL^DILFD(9000010.18,.04,"",$PIECE(Y,"^",4))
+13 IF '$TEST
SET X=X_$PIECE(CODE,"^",3)
+14 SET X=X_" Quantity: "_QUAN
End DoDot:3
+15 IF $GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+16 SET X="^Procedure^"
+17 IF $PIECE(Y,"^",4)
SET X=X_$$EXTERNAL^DILFD(9000010.18,.04,"",$PIECE(Y,"^",4))
+18 IF '$TEST
SET X=X_$PIECE(CODE,"^",3)
+19 SET X=X_"^"_$PIECE(CODE,"^",2)_"^"_$$SOURCE(9000010.18)_"^"_QUAN
End DoDot:3
+20 DO INC(X,.CNT)
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
HF ; -- Expand Health Factors
+1 NEW IBDY,IBDJ,IEN,X,Y,Z
+2 FOR IBDJ=1:1
SET IBDY=$PIECE(ENCTRS,"^",IBDJ)
if 'IBDY
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("PXKENC",$JOB,IBDY,"HF",IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 DO GETY(.Y,IBDY,"HF",IEN)
+5 IF '$GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+6 SET X=" Health Factor: "_$EXTRACT($$EXTERNAL^DILFD(9000010.23,.01,"",+Y)_L,1,25)
+7 IF $PIECE(Y,"^",4)'=""
SET X=X_" Severity="_$$EXTERNAL^DILFD(9000010.23,.04,"",$PIECE(Y,"^",4))
End DoDot:3
+8 ;
+9 IF $GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+10 SET X=""
+11 IF $PIECE(Y,"^",4)'=""
SET X=$$EXTERNAL^DILFD(9000010.23,.04,"",$PIECE(Y,"^",4))
+12 SET X=X_"^Health Factor^"_$EXTRACT($$EXTERNAL^DILFD(9000010.23,.01,"",+Y),1,25)
+13 SET $PIECE(X,"^",5)=$$SOURCE(9000010.23)
End DoDot:3
+14 DO INC(X,.CNT)
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
IMM ; -- Expand Immunizations
+1 NEW IBDY,IBDJ,IEN,X,Y
+2 FOR IBDJ=1:1
SET IBDY=$PIECE(ENCTRS,"^",IBDJ)
if 'IBDY
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("PXKENC",$JOB,IBDY,"IMM",IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 DO GETY(.Y,IBDY,"IMM",IEN)
+5 IF '$GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+6 SET X=" Immunization: "_$$EXTERNAL^DILFD(9000010.11,.01,"",+Y)
+7 IF $PIECE(Y,"^",7)
SET X=X_" Contraindicated!"
End DoDot:3
+8 ;
+9 IF $GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+10 SET X=""
IF $PIECE(Y,"^",7)
SET X="Contraindicated"
+11 SET X=X_"^Immunization^"_$$EXTERNAL^DILFD(9000010.11,.01,"",+Y)
+12 SET $PIECE(X,"^",5)=$$SOURCE(9000010.11)
End DoDot:3
+13 DO INC(X,.CNT)
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
PED ; -- Expand Patient Education
+1 NEW IBDY,IBDJ,IEN,X,Y
+2 FOR IBDJ=1:1
SET IBDY=$PIECE(ENCTRS,"^",IBDJ)
if 'IBDY
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("PXKENC",$JOB,IBDY,"PED",IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 DO GETY(.Y,IBDY,"PED",IEN)
+5 IF '$GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+6 SET X=" Education Topic: "_$EXTRACT($$EXTERNAL^DILFD(9000010.16,.01,"",+Y)_L,1,25)
+7 IF $PIECE(Y,"^",6)'=""
SET X=X_" Understanding="_$$EXTERNAL^DILFD(9000010.16,.06,"",$PIECE(Y,"^",6))
End DoDot:3
+8 ;
+9 IF $GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+10 SET X=""
+11 IF $PIECE(Y,"^",6)'=""
SET X=$$EXTERNAL^DILFD(9000010.16,.06,"",$PIECE(Y,"^",6))
+12 SET X=X_"^Education Topic^"_$EXTRACT($$EXTERNAL^DILFD(9000010.16,.01,"",+Y),1,25)
+13 SET $PIECE(X,"^",5)=$$SOURCE(9000010.16)
End DoDot:3
+14 DO INC(X,.CNT)
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
SK ; -- Expand Skin Tests
+1 NEW IBDY,IBDJ,IEN,X,Y,Z
+2 FOR IBDJ=1:1
SET IBDY=$PIECE(ENCTRS,"^",IBDJ)
if 'IBDY
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("PXKENC",$JOB,IBDY,"SK",IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 DO GETY(.Y,IBDY,"SK",IEN)
+5 IF '$GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+6 SET X=" Skin Test: "_$EXTRACT($$EXTERNAL^DILFD(9000010.12,.01,"",+Y)_L,1,25)
+7 IF $PIECE(Y,"^",4)'=""
SET X=X_" Result="_$$EXTERNAL^DILFD(9000010.12,.04,"",$PIECE(Y,"^",4))
End DoDot:3
+8 ;
+9 IF $GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+10 SET X=$$EXTERNAL^DILFD(9000010.12,.04,"",$PIECE(Y,"^",4))
+11 SET X=X_"^Skin Test^"_$EXTRACT($$EXTERNAL^DILFD(9000010.12,.01,"",+Y),1,25)
+12 SET $PIECE(X,"^",5)=$$SOURCE(9000010.12)
End DoDot:3
+13 DO INC(X,.CNT)
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
TRT ; -- Expand Treatments
+1 NEW IBDY,IBDJ,IEN,X,Y,TRT
+2 FOR IBDJ=1:1
SET IBDY=$PIECE(ENCTRS,"^",IBDJ)
if 'IBDY
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("PXKENC",$JOB,IBDY,"TRT",IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 DO GETY(.Y,IBDY,"TRT",IEN)
+5 SET TRT=$$EXTERNAL^DILFD(9000010.15,.01,"",+Y)
+6 IF TRT="OTHER"
SET TRT=$$EXTERNAL^DILFD(9000010.15,.06,"",$PIECE(Y,"^",6))
+7 IF '$GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+8 SET X=" Treatment: "_TRT
End DoDot:3
+9 IF $GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+10 SET X="^Treatment^"_TRT
+11 SET $PIECE(X,"^",5)=$$SOURCE(9000010.15)
End DoDot:3
+12 DO INC(X,.CNT)
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
XAM ; -- Expand Exams
+1 NEW IBDY,IBDJ,IEN,X,Y
+2 FOR IBDJ=1:1
SET IBDY=$PIECE(ENCTRS,"^",IBDJ)
if 'IBDY
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("PXKENC",$JOB,IBDY,"XAM",IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 DO GETY(.Y,IBDY,"XAM",IEN)
+5 IF '$GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+6 SET X=" Exam: "_$EXTRACT($$EXTERNAL^DILFD(9000010.13,.01,"",+Y)_L,1,25)
+7 SET X=X_" Result="_$$EXTERNAL^DILFD(9000010.13,.04,"",$PIECE(Y,"^",4))
End DoDot:3
+8 ;
+9 IF $GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+10 SET X=$$EXTERNAL^DILFD(9000010.13,.04,"",$PIECE(Y,"^",4))
+11 SET X=X_"^Exam^"_$EXTRACT($$EXTERNAL^DILFD(9000010.13,.01,"",+Y),1,25)
+12 SET $PIECE(X,"^",5)=$$SOURCE(9000010.13)
End DoDot:3
+13 DO INC(X,.CNT)
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
VST ; -- Expand visit entry
+1 NEW IBDY,IBDJ,IBDZ,IEN,X,Y
+2 FOR IBDJ=1:1
SET IBDY=$PIECE(ENCTRS,"^",IBDJ)
if 'IBDY
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("PXKENC",$JOB,IBDY,"VST",IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 DO GETY(.Y,IBDY,"VST",IEN)
+5 IF '$GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+6 SET X=" Encounter Info: "_$$EXTERNAL^DILFD(9000010,.22,"",$PIECE(Y,"^",22))_" - "_$$FMTE^XLFDT(+Y)_" - "_$$EXTERNAL^DILFD(9000010,15003,"",$PIECE(Y(150),"^",3))_" Encounter"
+7 DO INC(X,.CNT)
+8 SET X=""
+9 SET X=$$SOURCE(9000010)
IF X'=""
SET X=$EXTRACT(L,1,22)_"Source - "_X
+10 IF $PIECE(Y(800),"^",1)'=""
SET X=X_", SC := "_$SELECT($PIECE(Y(800),"^",1):"Yes",1:"No")
+11 IF $PIECE(Y(800),"^",2)'=""
SET X=X_", AO:="_$SELECT($PIECE(Y(800),"^",2):"Yes",1:"No")
+12 IF $PIECE(Y(800),"^",3)'=""
SET X=X_", IR:="_$SELECT($PIECE(Y(800),"^",3):"Yes",1:"No")
+13 IF $PIECE(Y(800),"^",4)'=""
SET X=X_", EC:="_$SELECT($PIECE(Y(800),"^",4):"Yes",1:"No")
End DoDot:3
+14 ;
+15 IF $GET(IBDATA("UNFORMAT"))
Begin DoDot:3
+16 SET X=$$EXTERNAL^DILFD(9000010,15003,"",$PIECE(Y(150),"^",3))_"^Encounter^"
+17 SET X=X_$$EXTERNAL^DILFD(9000010,.22,"",$PIECE(Y,"^",22))_"^"_$$FMTE^XLFDT(+Y)_"^"
+18 SET X=X_$$SOURCE(9000010)
+19 FOR IBDZ=1:1:4
IF $PIECE(Y(800),"^",IBDZ)'=""
SET $PIECE(X,"^",(6+IBDZ))=$PIECE(Y(800),"^",IBDZ)
End DoDot:3
+20 IF X'=""
DO INC(X,.CNT)
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
INC(X,CNT) ; -- increment results array
+1 SET CNT=CNT+1
+2 SET RESULT(CNT)=X
+3 QUIT
+4 ;
GETY(Y,IBDY,TYPE,IEN) ; -- return y array
+1 SET Y=$GET(^TMP("PXKENC",$JOB,IBDY,TYPE,IEN,0))
+2 SET Y(150)=$GET(^TMP("PXKENC",$JOB,IBDY,TYPE,IEN,150))
+3 SET Y(812)=$GET(^TMP("PXKENC",$JOB,IBDY,TYPE,IEN,812))
+4 IF TYPE="VST"
SET Y(800)=$GET(^TMP("PXKENC",$JOB,IBDY,TYPE,IEN,800))
+5 QUIT
+6 ;
SOURCE(FILE) ; -- return source of data
+1 NEW X
SET X=""
+2 IF $PIECE(Y(812),"^",3)'=""
SET X=$$EXTERNAL^DILFD(FILE,81203,"",$PIECE(Y(812),"^",3))
+3 IF X=""
IF $PIECE(Y(812),"^",2)'=""
SET X=$$EXTERNAL^DILFD(FILE,81202,"",$PIECE(Y(812),"^",2))
+4 QUIT X
+5 ;
TEST GOTO TEST^IBDFRPC5
TESTW GOTO TESTW^IBDFRPC5
