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 ---[H[J[2J[HRMPFQP4 1214 printed Nov 22, 2024@17:46:52 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
