RMPFQT2 ;DDC/KAW-QUEUE TRANSMISSION BATCH [ 06/16/95 3:06 PM ]
;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
; input: RMPFX
;output: RMPFX,SZ,XX
S (RMPFNAM,RMPFSSN,RMPFDOB,RMPFADD,RMPFSTAT,RMPFZIP,RMPFCL,RMPEBE)="UNKNOWN" K RMPFE
S DFN=$P(^RMPF(791810,RMPFX,0),U,4) G END:'DFN D DEM^VADPT
S RMPFNAM=VADM(1),RMPFSSN=$P(VADM(2),U,1),RMPFDOB=$P(VADM(3),U,1)
D ELIG^VADPT S RMPFCL=VAEL(7)
I $D(^RMPF(791810,RMPFX,1)) S S1=^(1),PT=1 D G ADD:$D(S1)
.S X=$P(S1,U,7) I X,DT<X K S1 Q
.S X=$P(S1,U,8) I X,DT>X K S1 Q
.I $P(S1,U,4)=""!($P(S1,U,5)="") K S1
.Q
ADD D ADD^VADPT S X=$P(VAPA(5),U,1)
I X,$D(^DIC(5,X,0)) S:$P(^(0),U,2)'="" RMPFSTAT=$P(^(0),U,2)
S RMPFADD=VAPA(1)_U_VAPA(2)_U_VAPA(3)_U_VAPA(4)_U_RMPFSTAT_U_VAPA(6)
S RMPEBE=$P(VAPA(9),U,1)_U_$P(VAPA(10),U,1)
S RMPFELG=$P($G(^RMPF(791810,RMPFX,2)),U,2)
S RMPFELGP=$P(VAEL(1),U,2)
ELG1 I RMPFELG,$D(^RMPF(791810.4,RMPFELG,0)) S RMPFELG=$P(^(0),U,1)
S SZ=RMPFNAM_U_RMPFSSN_U_RMPFDOB_U_RMPFCL_U_RMPFADD_U_RMPFELGP_U_RMPFELG_U_RMPEBE
S XX="" F I=2:1 Q:'$D(RMPFF(I)) S XX=$S(I>2:XX_U_RMPFF(I),1:RMPFF(I))
END K RMPFNAM,RMPFSSN,RMPFDOB,RMPFELG,RMPFADD,RMPFSTAT,VADM,VAEL,VAPA,VA
K RMPFELS,RMPFF,RMPFELGD,RMPFELD,RMPFELP,RMPEBE,VAERR,RMPFELGP
K RMPFL,RMPFZIP,RMPFCL,DFN,RMPFELG,PT,ST,S0,S1,S2,I,X,D,N,P Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFQT2 1297 printed Dec 13, 2024@02:36:58 Page 2
RMPFQT2 ;DDC/KAW-QUEUE TRANSMISSION BATCH [ 06/16/95 3:06 PM ]
+1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
+2 ; input: RMPFX
+3 ;output: RMPFX,SZ,XX
+4 SET (RMPFNAM,RMPFSSN,RMPFDOB,RMPFADD,RMPFSTAT,RMPFZIP,RMPFCL,RMPEBE)="UNKNOWN"
KILL RMPFE
+5 SET DFN=$PIECE(^RMPF(791810,RMPFX,0),U,4)
if 'DFN
GOTO END
DO DEM^VADPT
+6 SET RMPFNAM=VADM(1)
SET RMPFSSN=$PIECE(VADM(2),U,1)
SET RMPFDOB=$PIECE(VADM(3),U,1)
+7 DO ELIG^VADPT
SET RMPFCL=VAEL(7)
+8 IF $DATA(^RMPF(791810,RMPFX,1))
SET S1=^(1)
SET PT=1
Begin DoDot:1
+9 SET X=$PIECE(S1,U,7)
IF X
IF DT<X
KILL S1
QUIT
+10 SET X=$PIECE(S1,U,8)
IF X
IF DT>X
KILL S1
QUIT
+11 IF $PIECE(S1,U,4)=""!($PIECE(S1,U,5)="")
KILL S1
+12 QUIT
End DoDot:1
if $DATA(S1)
GOTO ADD
ADD DO ADD^VADPT
SET X=$PIECE(VAPA(5),U,1)
+1 IF X
IF $DATA(^DIC(5,X,0))
if $PIECE(^(0),U,2)'=""
SET RMPFSTAT=$PIECE(^(0),U,2)
+2 SET RMPFADD=VAPA(1)_U_VAPA(2)_U_VAPA(3)_U_VAPA(4)_U_RMPFSTAT_U_VAPA(6)
+3 SET RMPEBE=$PIECE(VAPA(9),U,1)_U_$PIECE(VAPA(10),U,1)
+4 SET RMPFELG=$PIECE($GET(^RMPF(791810,RMPFX,2)),U,2)
+5 SET RMPFELGP=$PIECE(VAEL(1),U,2)
ELG1 IF RMPFELG
IF $DATA(^RMPF(791810.4,RMPFELG,0))
SET RMPFELG=$PIECE(^(0),U,1)
+1 SET SZ=RMPFNAM_U_RMPFSSN_U_RMPFDOB_U_RMPFCL_U_RMPFADD_U_RMPFELGP_U_RMPFELG_U_RMPEBE
+2 SET XX=""
FOR I=2:1
if '$DATA(RMPFF(I))
QUIT
SET XX=$SELECT(I>2:XX_U_RMPFF(I),1:RMPFF(I))
END KILL RMPFNAM,RMPFSSN,RMPFDOB,RMPFELG,RMPFADD,RMPFSTAT,VADM,VAEL,VAPA,VA
+1 KILL RMPFELS,RMPFF,RMPFELGD,RMPFELD,RMPFELP,RMPEBE,VAERR,RMPFELGP
+2 KILL RMPFL,RMPFZIP,RMPFCL,DFN,RMPFELG,PT,ST,S0,S1,S2,I,X,D,N,P
QUIT
