- 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 Apr 23, 2025@18:51:25 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
