BCH1INI4.m

BCH1INI4 ; IHS/TUCSON/LAB - NO DESCRIPTION PROVIDED ; 

 ;;1.0;IHS RPMS CHR SYSTEM;**2**;OCT 28, 1996

 ;

 ;

EN S DA(1)=1,DIK="^ORD(100.99,1,5," I $D(^ORD(100.99,1,5,DA)) D ^DIK

 S %X="^UTILITY(U,$J,""OR"","_$O(^UTILITY(U,$J,"OR",""))_",",%Y=DIK_DA_","

 S:'$D(^ORD(100.99,1,5,0)) ^(0)="^100.995P^^" S $P(^(0),U,3,4)=DA_U_($P(^(0),U,4)+1)

 D %XY^%RCR S $P(^ORD(100.99,1,5,DA,0),U)=DA,%=$P(^(0),U,4)

 I %]"" S %=$O(^ORD(100.98,"B",%,0)) I %>0 S $P(^ORD(100.99,1,5,DA,0),U,4)=%

 D OR

 S DA(1)=1 D IX1^DIK

 Q

OR S (N,I)=0,X=""

 F  S N=$O(^ORD(100.99,1,5,DA,1,N)) Q:'N  S X=$P(^(N,0),U) I X]"" S %=$O(^ORD(101,"B",X,0)) D:'% ADDP S:% ^ORD(100.99,1,5,DA,1,N,0)=% S X=N,I=I+1,(R,J)=0,Y="" D OR1

 S:I $P(^ORD(100.99,1,5,DA,1,0),U,3,4)=X_U_I S (N,I)=0,X=""

 F  S N=$O(^ORD(100.99,1,5,DA,5,N)) Q:'N  S X=$P(^(N,0),U,3) I X]"" S %=$O(^ORD(101,"B",X,0)) D:'% ADDP S:% $P(^ORD(100.99,1,5,DA,5,N,0),U,3)=% S X=N,I=I+1

 S:I $P(^ORD(100.99,1,5,DA,5,0),U,3,4)=X_U_I K N,R,X,Y,I,J

 Q

OR1 N X F  S R=$O(^ORD(100.99,1,5,DA,1,N,1,R)) Q:'R  S X=$P(^(R,0),U) I X]"" S %=$O(^ORD(101,"B",X,0)) D:'% ADDP S:% ^ORD(100.99,1,5,DA,1,N,1,R,0)=% S Y=R,J=J+1

 S:J $P(^ORD(100.99,1,5,DA,1,N,1,0),U,3,4)=Y_U_J

 Q

ADDP N I,J,N,R,DA,DLAYGO S %=""

 S DIC="^ORD(101,",DIC(0)="LX",DLAYGO=101 D FILE^DICN K DIC Q:Y=-1  S %=+Y Q

BCH1INI4  ; IHS/TUCSON/LAB - NO DESCRIPTION PROVIDED ; 

 +1       ;;1.0;IHS RPMS CHR SYSTEM;**2**;OCT 28, 1996

 +2       ;

 +3       ;

EN         SET DA(1)=1

           SET DIK="^ORD(100.99,1,5,"

           IF $DATA(^ORD(100.99,1,5,DA))

               DO ^DIK

 +1        SET %X="^UTILITY(U,$J,""OR"","_$ORDER(^UTILITY(U,$JOB,"OR",""))_","

           SET %Y=DIK_DA_","

 +2        IF '$DATA(^ORD(100.99,1,5,0))

               SET ^(0)="^100.995P^^"

           SET $PIECE(^(0),U,3,4)=DA_U_($PIECE(^(0),U,4)+1)

 +3        DO %XY^%RCR

           SET $PIECE(^ORD(100.99,1,5,DA,0),U)=DA

           SET %=$PIECE(^(0),U,4)

 +4        IF %]""

               SET %=$ORDER(^ORD(100.98,"B",%,0))

               IF %>0

                   SET $PIECE(^ORD(100.99,1,5,DA,0),U,4)=%

 +5        DO OR

 +6        SET DA(1)=1

           DO IX1^DIK

 +7        QUIT 

OR         SET (N,I)=0

           SET X=""

 +1        FOR 

               SET N=$ORDER(^ORD(100.99,1,5,DA,1,N))

               IF 'N

                   QUIT 

               SET X=$PIECE(^(N,0),U)

               IF X]""

                   SET %=$ORDER(^ORD(101,"B",X,0))

                   IF '%

                       DO ADDP

                   IF %

                       SET ^ORD(100.99,1,5,DA,1,N,0)=%

                   SET X=N

                   SET I=I+1

                   SET (R,J)=0

                   SET Y=""

                   DO OR1

 +2        IF I

               SET $PIECE(^ORD(100.99,1,5,DA,1,0),U,3,4)=X_U_I

           SET (N,I)=0

           SET X=""

 +3        FOR 

               SET N=$ORDER(^ORD(100.99,1,5,DA,5,N))

               IF 'N

                   QUIT 

               SET X=$PIECE(^(N,0),U,3)

               IF X]""

                   SET %=$ORDER(^ORD(101,"B",X,0))

                   IF '%

                       DO ADDP

                   IF %

                       SET $PIECE(^ORD(100.99,1,5,DA,5,N,0),U,3)=%

                   SET X=N

                   SET I=I+1

 +4        IF I

               SET $PIECE(^ORD(100.99,1,5,DA,5,0),U,3,4)=X_U_I

           KILL N,R,X,Y,I,J

 +5        QUIT 

OR1        NEW X

           FOR 

               SET R=$ORDER(^ORD(100.99,1,5,DA,1,N,1,R))

               IF 'R

                   QUIT 

               SET X=$PIECE(^(R,0),U)

               IF X]""

                   SET %=$ORDER(^ORD(101,"B",X,0))

                   IF '%

                       DO ADDP

                   IF %

                       SET ^ORD(100.99,1,5,DA,1,N,1,R,0)=%

                   SET Y=R

                   SET J=J+1

 +1        IF J

               SET $PIECE(^ORD(100.99,1,5,DA,1,N,1,0),U,3,4)=Y_U_J

 +2        QUIT 

ADDP       NEW I,J,N,R,DA,DLAYGO

           SET %=""

 +1        SET DIC="^ORD(101,"

           SET DIC(0)="LX"

           SET DLAYGO=101

           DO FILE^DICN

           KILL DIC

           IF Y=-1

               QUIT 

           SET %=+Y

           QUIT