IBDY2117 ;ALB/JLS - KIDS post-install for patch IBD*2.1*17
;;Version 2.1 ; AUTOMATED INFO COLLECTION SYS ;**17**; 3-APR-96
;
D PXACT,ICD9
Q
;
PXACT ; -- if PCE is installed, activate Selection Interfaces in file 357.6.
N I,J,X,Y
I $D(^AUTTEDT(0)) D ; education topics installed
.F I=1:1 S X=$P($T(INTRFCE+I),";;",2) Q:X="" D
..S IBDIEN=$O(^IBE(357.6,"B",X,0))
..Q:'IBDIEN
..Q:$G(^IBE(357.6,IBDIEN,0))=""
..Q:$P($G(^IBE(357.6,IBDIEN,0)),"^",9)=1 ; already available
..S $P(^IBE(357.6,IBDIEN,0),"^",9)=1 ; makes it available
..D MES^XPDUTL(">>> Updating Package Interface Entry for "_X)
..Q
.Q
K IBDIEN
Q
;
INTRFCE ;
;;PX SELECT EDUCATION TOPICS
;;PX SELECT EXAMS
;;PX SELECT HEALTH FACTORS
;;PX SELECT IMMUNIZATIONS
;;PX SELECT SKIN TESTS
;;PX SELECT TREATMENTS
;;
;
ICD9 N IBDA,IBDX
S IBDA=0 F S IBDA=$O(^IBE(357.6,"B","INPUT DIAGNOSIS CODE (ICD9)",IBDA)) Q:'IBDA D
.S IBDX=$G(^IBE(357.6,IBDA,0))
.Q:IBDX=""!($P(IBDX,"^")'="INPUT DIAGNOSIS CODE (ICD9)")
.Q:$P($G(^IBE(357.6,IBDA,12)),"^")="DIAGNOSIS/PROBLEM"
.S ^IBE(357.6,IBDA,12)="DIAGNOSIS/PROBLEM^1^13^14^2^^^"
.D MES^XPDUTL(">>> Updating Package Interface Entry for INPUT DIAGNOSIS CODE (ICD9)")
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDY2117 1235 printed Dec 13, 2024@02:55:12 Page 2
IBDY2117 ;ALB/JLS - KIDS post-install for patch IBD*2.1*17
+1 ;;Version 2.1 ; AUTOMATED INFO COLLECTION SYS ;**17**; 3-APR-96
+2 ;
+3 DO PXACT
DO ICD9
+4 QUIT
+5 ;
PXACT ; -- if PCE is installed, activate Selection Interfaces in file 357.6.
+1 NEW I,J,X,Y
+2 ; education topics installed
IF $DATA(^AUTTEDT(0))
Begin DoDot:1
+3 FOR I=1:1
SET X=$PIECE($TEXT(INTRFCE+I),";;",2)
if X=""
QUIT
Begin DoDot:2
+4 SET IBDIEN=$ORDER(^IBE(357.6,"B",X,0))
+5 if 'IBDIEN
QUIT
+6 if $GET(^IBE(357.6,IBDIEN,0))=""
QUIT
+7 ; already available
if $PIECE($GET(^IBE(357.6,IBDIEN,0)),"^",9)=1
QUIT
+8 ; makes it available
SET $PIECE(^IBE(357.6,IBDIEN,0),"^",9)=1
+9 DO MES^XPDUTL(">>> Updating Package Interface Entry for "_X)
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 KILL IBDIEN
+13 QUIT
+14 ;
INTRFCE ;
+1 ;;PX SELECT EDUCATION TOPICS
+2 ;;PX SELECT EXAMS
+3 ;;PX SELECT HEALTH FACTORS
+4 ;;PX SELECT IMMUNIZATIONS
+5 ;;PX SELECT SKIN TESTS
+6 ;;PX SELECT TREATMENTS
+7 ;;
+8 ;
ICD9 NEW IBDA,IBDX
+1 SET IBDA=0
FOR
SET IBDA=$ORDER(^IBE(357.6,"B","INPUT DIAGNOSIS CODE (ICD9)",IBDA))
if 'IBDA
QUIT
Begin DoDot:1
+2 SET IBDX=$GET(^IBE(357.6,IBDA,0))
+3 if IBDX=""!($PIECE(IBDX,"^")'="INPUT DIAGNOSIS CODE (ICD9)")
QUIT
+4 if $PIECE($GET(^IBE(357.6,IBDA,12)),"^")="DIAGNOSIS/PROBLEM"
QUIT
+5 SET ^IBE(357.6,IBDA,12)="DIAGNOSIS/PROBLEM^1^13^14^2^^^"
+6 DO MES^XPDUTL(">>> Updating Package Interface Entry for INPUT DIAGNOSIS CODE (ICD9)")
+7 QUIT
End DoDot:1
+8 QUIT
