IBDY340.m

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 ---IBDY340   645     printed  Apr 09, 2024@21:34:16                                                                                                                                                                                                      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