| 1 | RMPFQP3 ;DDC/KAW-PRINT VA FORM 10-2477a [ 03/12/98 7:46 AM ]
|
|---|
| 2 | ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**10**;;JUN 16, 1995
|
|---|
| 3 | ; input: RMPFX
|
|---|
| 4 | ;output: None
|
|---|
| 5 | F KX=1:1:RMPFCNT D PRINT
|
|---|
| 6 | G END
|
|---|
| 7 | PRINT Q:'$D(RMPFX) Q:'RMPFX Q:'$D(^RMPF(791810,RMPFX,0)) S RMPFTYP=$P(^(0),U,2)
|
|---|
| 8 | D ^RMPFQP1 S DFN=$P(^RMPF(791810,RMPFX,0),U,4)
|
|---|
| 9 | D ^RMPFDT5,^RMPFDD2,HEAD,HEAD1,ELG,P1 G END:$D(RMPFOUT)
|
|---|
| 10 | W !,"9. Currently Authorized Hearing Aid(s)"
|
|---|
| 11 | S X=$O(^RMPF(791810,RMPFX,301,0)) I X,$D(^(X,0)) S Y=$P(^(0),U,8) I Y D DD^%DT W " as of: ",Y
|
|---|
| 12 | D LINE
|
|---|
| 13 | W !?2,"Manfacturer",?16,"|",?22,"Model",?32,"|",?34,"Serial Number",?48,"|",?50,"Furnished By",?64,"|",?67,"Date Issued"
|
|---|
| 14 | D LINE
|
|---|
| 15 | I $D(^RMPF(791810,RMPFX,301,0)) D AUTH^RMPFQP4 G NEXT
|
|---|
| 16 | F I=1:1:4 W !,?16,"|",?32,"|",?48,"|",?64,"|" D LINE
|
|---|
| 17 | NEXT I $Y>19 D CONT^RMPFQP2
|
|---|
| 18 | W !,"10. Clinic Action Taken __ VETERAN DOES NOT REQUIRE NEW HEARING AID"
|
|---|
| 19 | W !?27,"__ VETERAN DOES NOT REQUIRE HEARING AID"
|
|---|
| 20 | W !?27,"__ ITEM(S) LISTED BELOW WERE ISSUED TO VETERAN"
|
|---|
| 21 | D LINE
|
|---|
| 22 | D CONT^RMPFQP2 G END:$D(RMPFOUT) D LINE:IOST?1"C-".E
|
|---|
| 23 | CLINIC W !,?16,"|",?27,"|",?44,"|",?57,"| Battery",?67,"| Serial No."
|
|---|
| 24 | W !,"Natl. Stock No.",?16,"|",?20,"Make",?27,"|",?33,"Model"
|
|---|
| 25 | W ?44,"| Serial No.",?57,"| Type",?67,"| Replaced"
|
|---|
| 26 | D LINE
|
|---|
| 27 | D MOD^RMPFQP1
|
|---|
| 28 | D CONT^RMPFQP2 G END:$D(RMPFOUT) D LINE:IOST?1"C-".E
|
|---|
| 29 | I $Y>58 D CONT
|
|---|
| 30 | W !,"11. Type of Fitting",?28,":",?32,RMPFTF
|
|---|
| 31 | D LINE
|
|---|
| 32 | I $Y>58 D CONT
|
|---|
| 33 | I RMPFTYP=11 S RMPFUS="*** LOANER AID ***"
|
|---|
| 34 | W !,"12. Authorized Usage of Aids:",?32,RMPFUS
|
|---|
| 35 | D LINE
|
|---|
| 36 | I $Y>58 D CONT
|
|---|
| 37 | W !,"13. Issued aids to be replaced to clinic stock by DDC:",?56
|
|---|
| 38 | I RMPFHAT="S" W RMPFDDC
|
|---|
| 39 | E W "N/A"
|
|---|
| 40 | D LINE
|
|---|
| 41 | I $Y>58 D CONT
|
|---|
| 42 | W !,"14. Signature of Issuing Audiologist",?38,"|",?49,"Title",?65,"|15. Order Date"
|
|---|
| 43 | W !?38,"|",?65,"|"
|
|---|
| 44 | I $D(RMPFX) D ARRAY^RMPFDT2 S X=0 F S X=$O(RMPFO(X)) Q:'X I $D(^RMPF(791810,RMPFX,101,X,90)),$P(^(90),U,12) S Y=$P(^(90),U,12) I Y,$D(^VA(200,Y,0)) S RMPFADP=$P(^(0),U,1),RMPFAD=Y
|
|---|
| 45 | S T="Audiologist" I RMPFAD,$D(^VA(200,RMPFAD,0)) S X=$P(^(0),U,9) I X,$D(^DIC(3.1,X,0)) S T=$P(^(0),U,1)
|
|---|
| 46 | S T=$E(T,1,26),L=$L(T)
|
|---|
| 47 | W !?4,$P(RMPFADP,",",2)_" "_$P(RMPFADP,",",1),?38,"|",?39+((26-L)\2),T,?65,"|",?68,RMPFODP
|
|---|
| 48 | D LINE
|
|---|
| 49 | I $Y>58 D CONT
|
|---|
| 50 | W !,"16. I certify that I have",?37,"Signature of Veteran",?65,"|17. Date"
|
|---|
| 51 | W !?4,"received the item(s)",?65,"|"
|
|---|
| 52 | W !?4,"listed under 10 above ->",?65,"|"
|
|---|
| 53 | D LINE
|
|---|
| 54 | W !,"VA Form 10-2477a"
|
|---|
| 55 | W !,"SEP 1991"
|
|---|
| 56 | D CONT^RMPFQP2 I IOST?1"P-".E W @IOF
|
|---|
| 57 | D:$D(IO("S")) ^%ZISC
|
|---|
| 58 | END D KIL^RMPFQP4 Q
|
|---|
| 59 | P1 S AD="A" G P2:'$D(RMPFX)
|
|---|
| 60 | I $D(^RMPF(791810,RMPFX,1)) S S1=^(1) I $P(S1,U,5)'=""&($P(S1,U,6)'="") D G P3
|
|---|
| 61 | .S C=1 K RMPFA
|
|---|
| 62 | .F I=1:1:3 I $P(S1,U,I)'="" S RMPFA(C)=$P(S1,U,I),C=C+1
|
|---|
| 63 | .S RMPFA(C)=$P(S1,U,4)_", "_$P(^DIC(5,$P(S1,U,5),0),U,2)_" "_$P(S1,U,6)
|
|---|
| 64 | .Q
|
|---|
| 65 | P2 S:$D(RMPFT) AD="T"
|
|---|
| 66 | P3 W !,"1. Extended Audiology Clinic",?38,"| 2. Issuing Audiology Clinic"
|
|---|
| 67 | W !?3,"Station No. ",RMPFRSTA,?38,"|",?44,"Station No. ",RMPFSTAP
|
|---|
| 68 | W !?38,"|"
|
|---|
| 69 | F I=1:1:4 W ! W:$D(RMPFR(I)) ?3,$E(RMPFR(I),1,35) W ?38,"|" W:$D(RMPFS(I)) ?44,$E(RMPFS(I),1,36)
|
|---|
| 70 | D LINE
|
|---|
| 71 | W !,"3. Veteran's Name and Address ",?38,"| 4. Eligibility Status(es) ",?71,$J($E(RMPFELS,1,9),9)
|
|---|
| 72 | W !,?38,"|" I RMPFELD W ?70,$E(RMPFELD,4,5)_"-"_$E(RMPFELD,6,7)_"-"_($E(RMPFELD,1,3)+1700)
|
|---|
| 73 | S RMPFNAM=$P(RMPFNAM,",",2)_" "_$P(RMPFNAM,",",1)
|
|---|
| 74 | W !?3,$E(RMPFNAM,1,32),?38,"|",?44,RMPFF
|
|---|
| 75 | F I=1:1:4 I $D(@("RMPF"_AD_"(I)"))!$D(RMPFF(I+1)) W ! W:$D(@("RMPF"_AD_"(I)")) ?3,$E(@("RMPF"_AD_"(I)"),1,32) W ?38,"|" W:$D(RMPFF(I+1)) ?44,$E(RMPFF(I+1),1,36)
|
|---|
| 76 | D LINE
|
|---|
| 77 | D CONT^RMPFQP2 Q:$D(RMPFOUT) D LINE:IOST?1"C-".E
|
|---|
| 78 | W !,"5. Soc. Security No.",?20,"| 6. VA Claim No.",?38,"| 7. Date of Birth",?59,"| 8. Disability Code"
|
|---|
| 79 | W !?20,"|",?38,"|",?59,"|"
|
|---|
| 80 | W !?3,RMPFSSN,?20,"|",?25,RMPFCL,?38,"|",?43,RMPFDOB,?59,"|"
|
|---|
| 81 | W ?64,RMPFDC
|
|---|
| 82 | D LINE
|
|---|
| 83 | Q
|
|---|
| 84 | LINE W !,"--------------------------------------------------------------------------------"
|
|---|
| 85 | Q
|
|---|
| 86 | HEAD W:$Y>0 @IOF W !?25,"DEPARTMENT OF VETERANS AFFAIRS"
|
|---|
| 87 | W !?21,"AUDIOLOGICAL SERVICES ACKNOWLEDGEMENT"
|
|---|
| 88 | D LINE Q
|
|---|
| 89 | HEAD1 W:$D(RMPFSTP) !,"Order Status: *** ",RMPFSTP," ***"
|
|---|
| 90 | W ?59,"Printed: ",RMPFDAT
|
|---|
| 91 | D LINE Q
|
|---|
| 92 | ELG S RMPFF="" Q:'$D(RMPFX) S X=$P($G(^RMPF(791810,RMPFX,2)),U,2)
|
|---|
| 93 | I X,$D(^RMPF(791810.4,X,0)) S RMPFF=$P(^(0),U,1)
|
|---|
| 94 | Q
|
|---|
| 95 | CONT Q:IOST'["P-"
|
|---|
| 96 | D HEAD,HEAD1 W !!,"cont." D LINE Q
|
|---|
| 97 | READ K RMPFOUT,RMPFQUT
|
|---|
| 98 | R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
|
|---|
| 99 | I Y?1"^".E S (RMPFOUT,Y)="" Q
|
|---|
| 100 | S:Y?1"?".E (RMPFQUT,Y)=""
|
|---|
| 101 | Q
|
|---|
