IBDEINI4 ; ; 01-AUG-2022
;;3.0;IB ENCOUNTER FORM IMP/EXP;;AUG 01, 2022
;
;
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,DO S %=""
S DIC="^ORD(101,",DIC(0)="LX",DLAYGO=101 D FILE^DICN K DIC Q:Y=-1 S %=+Y Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDEINI4 1283 printed Oct 16, 2024@18:51:16 Page 2
IBDEINI4 ; ; 01-AUG-2022
+1 ;;3.0;IB ENCOUNTER FORM IMP/EXP;;AUG 01, 2022
+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,DO
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
