IBYPPCC.m

IBYPPCC ;ALB/TMP - IB*2*52 POST INSTALL:  UPDATE HCFA 1500 ; 30-APR-1997

 ;;Version 2.0 ; INTEGRATED BILLING ;**52**; 21-MAR-94

 ;

EN N Z,Z0,Z1,DA,DIE,DIK,DR

 G:$O(^IBA(364.6,"ASEQ",2,1,""),-1)>62!($O(^IBA(364.6,"ASEQ",2,1,""))="") 1

 S Z="" F  S Z=$O(^IBA(364.6,"ASEQ",2,1,Z),-1) Q:'Z  S Z0="" F  S Z0=$O(^IBA(364.6,"ASEQ",2,1,Z,Z0)) Q:'Z0  D

 .S Z1=0 F  S Z1=$O(^IBA(364.6,"ASEQ",2,1,Z,Z0,Z1)) Q:'Z1  D

 ..S DIE="^IBA(364.6,",DA=Z1,DR=".05////"_(Z+1) D ^DIE

 I $D(^IBA(364.5,0)) D

 .S Z=0 F  S Z=$O(^IBA(364.6,Z)) Q:'Z  I '$D(^IBA(364.7,"B",Z)) S DA=Z,DIK="^IBA(364.6," D ^DIK

 .S Z=0 F  S Z=$O(^IBA(364.7,"B",Z)) Q:'Z  S Z0=+$O(^(Z,0)),DA=$O(^(Z0)) I DA S DIK="^IBA(364.7," D ^DIK

 ;

1 I $D(^IBA(364.5,0)) F Z=210:1:212 S DIK="^IBA(364.5,",DA=Z D ^DIK

 I $D(^IBA(364.7,"C",212)) S Z=0 F  S Z=$O(^IBA(364.7,"C",212,Z)) Q:'Z  S DIK="^IBA(364.7,",DA=Z D ^DIK

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBYPPCC   881     printed  Apr 09, 2024@21:29:34                                                                                                                                                                                                      Page 2

IBYPPCC   ;ALB/TMP - IB*2*52 POST INSTALL:  UPDATE HCFA 1500 ; 30-APR-1997

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;**52**; 21-MAR-94

 +2       ;

EN         NEW Z,Z0,Z1,DA,DIE,DIK,DR

 +1        if $ORDER(^IBA(364.6,"ASEQ",2,1,""),-1)>62!($ORDER(^IBA(364.6,"ASEQ",2,1,""))="")

               GOTO 1

 +2        SET Z=""

           FOR 

               SET Z=$ORDER(^IBA(364.6,"ASEQ",2,1,Z),-1)

               if 'Z

                   QUIT 

               SET Z0=""

               FOR 

                   SET Z0=$ORDER(^IBA(364.6,"ASEQ",2,1,Z,Z0))

                   if 'Z0

                       QUIT 

                   Begin DoDot:1

 +3                    SET Z1=0

                       FOR 

                           SET Z1=$ORDER(^IBA(364.6,"ASEQ",2,1,Z,Z0,Z1))

                           if 'Z1

                               QUIT 

                           Begin DoDot:2

 +4                            SET DIE="^IBA(364.6,"

                               SET DA=Z1

                               SET DR=".05////"_(Z+1)

                               DO ^DIE

                           End DoDot:2

                   End DoDot:1

 +5        IF $DATA(^IBA(364.5,0))

               Begin DoDot:1

 +6                SET Z=0

                   FOR 

                       SET Z=$ORDER(^IBA(364.6,Z))

                       if 'Z

                           QUIT 

                       IF '$DATA(^IBA(364.7,"B",Z))

                           SET DA=Z

                           SET DIK="^IBA(364.6,"

                           DO ^DIK

 +7                SET Z=0

                   FOR 

                       SET Z=$ORDER(^IBA(364.7,"B",Z))

                       if 'Z

                           QUIT 

                       SET Z0=+$ORDER(^(Z,0))

                       SET DA=$ORDER(^(Z0))

                       IF DA

                           SET DIK="^IBA(364.7,"

                           DO ^DIK

               End DoDot:1

 +8       ;

1          IF $DATA(^IBA(364.5,0))

               FOR Z=210:1:212

                   SET DIK="^IBA(364.5,"

                   SET DA=Z

                   DO ^DIK

 +1        IF $DATA(^IBA(364.7,"C",212))

               SET Z=0

               FOR 

                   SET Z=$ORDER(^IBA(364.7,"C",212,Z))

                   if 'Z

                       QUIT 

                   SET DIK="^IBA(364.7,"

                   SET DA=Z

                   DO ^DIK

 +2        QUIT 

 +3       ;