RMPFQP4.m

RMPFQP4 ;DDC/KAW-PRINT VA FORM 10-2477a [ 06/16/95   3:06 PM ]

 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995

 F KX=1:1:RMPFCNT D PRINT

 D KIL G END

PRINT S RMPFOD=DT,RMPFDC=""

 D ^RMPFQP1,^RMPFDD2,HEAD^RMPFQP3,HEAD1^RMPFQP3,ELG^RMPFQP3,P1^RMPFQP3

 G END:$D(RMPFOUT) D AUTH^RMPFQP2

END Q

KIL K RMPFRSTA,RMPFR,RMPFS,RMPFNAM,RMPFF,RMPFA,RMPFOUT,RMPFQUT,RMPFMSG

 K RMPFSSN,RMPFCL,RMPFDOB,RMPFDC,RMPFTF,RMPFUS,RMPFREP,RMPFADP

 K RMPFODP,RMPFSTP,RMPFAD,RMPFAP,RMPFAPD,RMPFAPP,RMPFBAT2,AD,ED,SD

 K RMPFDOD,RMPFDR,RMPFELG,RMPFELS,RMPFIDP,RMPFL,RMPFST,RMPFT,RMPFCARE

 K RMPFTDP,RMPFOD,RMPFDDC,RMPFRMK,RMPFTED,RMPFTSD,RMPFTYP,RMPFCAR

 K RMPFUR,RMPFURP,RMPFVET,RMPFID,RMPFELGD,RMPFELD,RMPFELP,RMPFCUR

 K RMPFERR,RMPFINV,RMPFPO,RMPFRDC,RMPFTP,RMPFTYPP,RMPFTA,SA

 K DOB,SSN,RMPFCX,RMPFAD,S0,S3,S6,ST,IN,A,B,C,D,S,T,Z,I,N,P,X,Y,%

 Q

AUTH S RMPFZ=0

A1 S RMPFZ=$O(^RMPF(791810,RMPFX,301,RMPFZ)) G AUTHE:'RMPFZ

 G A1:'$D(^RMPF(791810,RMPFX,301,RMPFZ,0)) S S0=^(0)

 S MK=$E($P(S0,U,2),1,16),MD=$E($P(S0,U,1),1,15),SN=$E($P(S0,U,4),1,15)

 S FB=$E($P(S0,U,9),1,16),ID=$P(S0,U,3)

 I ID S Y=ID D DD^%DT S ID=Y

 W !,MK,?16,"|",?17,MD,?32,"|",?33,SN,?48,"|",?49,FB,?64,"|",?65,ID

 D LINE^RMPFQP3

 G A1

AUTHE Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RMPFQP4   1214     printed  Apr 09, 2024@21:39:21                                                                                                                                                                                                     Page 2

RMPFQP4   ;DDC/KAW-PRINT VA FORM 10-2477a [ 06/16/95   3:06 PM ]

 +1       ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995

 +2        FOR KX=1:1:RMPFCNT

               DO PRINT

 +3        DO KIL

           GOTO END

PRINT      SET RMPFOD=DT

           SET RMPFDC=""

 +1        DO ^RMPFQP1

           DO ^RMPFDD2

           DO HEAD^RMPFQP3

           DO HEAD1^RMPFQP3

           DO ELG^RMPFQP3

           DO P1^RMPFQP3

 +2        if $DATA(RMPFOUT)

               GOTO END

           DO AUTH^RMPFQP2

END        QUIT 

KIL        KILL RMPFRSTA,RMPFR,RMPFS,RMPFNAM,RMPFF,RMPFA,RMPFOUT,RMPFQUT,RMPFMSG

 +1        KILL RMPFSSN,RMPFCL,RMPFDOB,RMPFDC,RMPFTF,RMPFUS,RMPFREP,RMPFADP

 +2        KILL RMPFODP,RMPFSTP,RMPFAD,RMPFAP,RMPFAPD,RMPFAPP,RMPFBAT2,AD,ED,SD

 +3        KILL RMPFDOD,RMPFDR,RMPFELG,RMPFELS,RMPFIDP,RMPFL,RMPFST,RMPFT,RMPFCARE

 +4        KILL RMPFTDP,RMPFOD,RMPFDDC,RMPFRMK,RMPFTED,RMPFTSD,RMPFTYP,RMPFCAR

 +5        KILL RMPFUR,RMPFURP,RMPFVET,RMPFID,RMPFELGD,RMPFELD,RMPFELP,RMPFCUR

 +6        KILL RMPFERR,RMPFINV,RMPFPO,RMPFRDC,RMPFTP,RMPFTYPP,RMPFTA,SA

 +7        KILL DOB,SSN,RMPFCX,RMPFAD,S0,S3,S6,ST,IN,A,B,C,D,S,T,Z,I,N,P,X,Y,%

 +8        QUIT 

AUTH       SET RMPFZ=0

A1         SET RMPFZ=$ORDER(^RMPF(791810,RMPFX,301,RMPFZ))

           if 'RMPFZ

               GOTO AUTHE

 +1        if '$DATA(^RMPF(791810,RMPFX,301,RMPFZ,0))

               GOTO A1

           SET S0=^(0)

 +2        SET MK=$EXTRACT($PIECE(S0,U,2),1,16)

           SET MD=$EXTRACT($PIECE(S0,U,1),1,15)

           SET SN=$EXTRACT($PIECE(S0,U,4),1,15)

 +3        SET FB=$EXTRACT($PIECE(S0,U,9),1,16)

           SET ID=$PIECE(S0,U,3)

 +4        IF ID

               SET Y=ID

               DO DD^%DT

               SET ID=Y

 +5        WRITE !,MK,?16,"|",?17,MD,?32,"|",?33,SN,?48,"|",?49,FB,?64,"|",?65,ID

 +6        DO LINE^RMPFQP3

 +7        GOTO A1

AUTHE      QUIT