IBDY340 ;ALB/DHH - POST INSTALL FOR PATCH IBD*3*40 ; OCT 1, 1999
;;3.0;AUTOMATED INFO COLLECTION SYS;**40**;APR 24, 1997
;
D ASK
;
Q
;
ASK ;-- Change PX INPUT HEALTH FACTORS to check for inactive
; in the package interface file
;
D MES^XPDUTL(">>> Updating PX INPUT HEALTH FACTORS Package Interface.")
N I,J,X
S I=0
F S I=$O(^IBE(357.6,"B",$E("PX INPUT HEALTH FACTORS",1,30),I)) Q:'I D
.I $P($G(^IBE(357.6,I,0)),"^")="PX INPUT HEALTH FACTORS" D
..S ^IBE(357.6,I,18)="S IBDF(""OTHER"")=""9999999.64^I '$P(^(0),U,10),$P(^(0),U,10)=""""F"""",'$P(^(0),U,11)"" D LIST^IBDFDE2(.IBDSEL,.IBDF,""Health Factors"")"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDY340 645 printed Nov 22, 2024@18:05:30 Page 2
IBDY340 ;ALB/DHH - POST INSTALL FOR PATCH IBD*3*40 ; OCT 1, 1999
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**40**;APR 24, 1997
+2 ;
+3 DO ASK
+4 ;
+5 QUIT
+6 ;
ASK ;-- Change PX INPUT HEALTH FACTORS to check for inactive
+1 ; in the package interface file
+2 ;
+3 DO MES^XPDUTL(">>> Updating PX INPUT HEALTH FACTORS Package Interface.")
+4 NEW I,J,X
+5 SET I=0
+6 FOR
SET I=$ORDER(^IBE(357.6,"B",$EXTRACT("PX INPUT HEALTH FACTORS",1,30),I))
if 'I
QUIT
Begin DoDot:1
+7 IF $PIECE($GET(^IBE(357.6,I,0)),"^")="PX INPUT HEALTH FACTORS"
Begin DoDot:2
+8 SET ^IBE(357.6,I,18)="S IBDF(""OTHER"")=""9999999.64^I '$P(^(0),U,10),$P(^(0),U,10)=""""F"""",'$P(^(0),U,11)"" D LIST^IBDFDE2(.IBDSEL,.IBDF,""Health Factors"")"
End DoDot:2
End DoDot:1
+9 QUIT
