28 lines
1.2 KiB
Mathematica
28 lines
1.2 KiB
Mathematica
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
|