RMPFQT2.m

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 ---RMPFQT2   1297     printed  Apr 09, 2024@21:39:44                                                                                                                                                                                                     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