RMPFQP2 ;DDC/KAW-PRINT VA FORM 10-2477a; [ 06/16/95 3:06 PM ]
;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
RMPFSET I '$D(RMPFMENU) D MENU^RMPFUTL I '$D(RMPFMENU) W !!,$C(7),"*** A MENU SELECTION MUST BE MADE ***" Q ;;RMPFMENU must be defined
I '$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS) D ^RMPFUTL Q:'$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS)
;; input: None
;;output: None
F KX=1:1:RMPFCNT D PRINT
G END
PRINT D ^RMPFQP1
W:$Y>0 @IOF W !?25,"DEPARTMENT OF VETERANS AFFAIRS"
W !?21,"AUDIOLOGICAL SERVICES ACKNOWLEDGEMENT"
D LINE
W !,"1. Extended Audiology Clinic",?38,"| 2. Issuing Audiology Clinic"
W !?3,"Station No. ",RMPFRSTA,?38,"|",?45,"Station No. ",RMPFSTAP
W !?38,"|"
F I=1:1:4 W ! W:$D(RMPFR(I)) ?3,$E(RMPFR(I),1,32) W ?38,"|" W:$D(RMPFS(I)) ?45,$E(RMPFS(I),1,36)
D LINE
NAM W !,"3. Veteran's Name and Address ",?38,"| 4. Eligibility Status(es) "
W !,?38,"|"
W ! W ?38,"| __ SC for Hearing",?61,"__ IN PAT"
W ! W ?38,"| __ 50-100% SC",?61,"__ NHCU"
W ! W ?38,"| __ POW",?61,"__ DOM"
W ! W ?38,"| __ WWI",?61,"__ OPT-NSC"
W ! W ?38,"| __ MBW",?61,"__ ADJ"
W !?38,"| __ A&A",?54,"__ ALLIED (Authority Req.)"
W !?38,"| __ HB",?54,"__ OTHER (Specify)"
D LINE
D CONT G END:$D(RMPFOUT) D LINE:IOST?1"C-".E
W !,"5. Soc. Security No.",?16,"| 6. VA Claim No.",?38,"| 7. Date of Birth",?59,"| 8. Disability Code"
W !?20,"|",?38,"|",?59,"|"
W !," - -",?20,"| - -",?38,"|",?59,"| __DEAF/U __DEAF/B"
D LINE
AUTH W !,"9. Currently Authorized Hearing Aid(s)"
D LINE
W !?2,"Manfacturer",?16,"|",?22,"Model",?32,"|",?34,"Serial Number",?48,"|",?50,"Furnished By",?64,"|",?67,"Date Issued"
D LINE
F I=1:1:4 W !,?16,"|",?32,"|",?48,"|",?64,"|" D LINE
CLINIC W !,"10. Clinic Action Taken __ VETERAN DOES NOT REQUIRE NEW HEARING AID"
W !?27,"__ VETERAN DOES NOT REQUIRE HEARING AID"
W !?27,"__ ITEM(S) LISTED BELOW WERE ISSUED TO VETERAN"
D LINE
D CONT G END:$D(RMPFOUT) D LINE:IOST?1"C-".E
W !,?16,"|",?27,"|",?44,"|",?57,"| Battery",?67,"| Serial No."
W !,"Natl. Stock No.",?16,"|",?20,"Make",?33,"Model"
W ?44,"| Serial No.",?57,"| Type",?67,"| Replaced"
D LINE
F I=1:1:2 W !,"6515-01-",?16,"|",?27,"|",?44,"|",?57,"|",?67,"|" D LINE
D CONT G END:$D(RMPFOUT) D LINE:IOST?1"C-".E
W !,"11. Type of Fitting",?24,"__ MONAURAL",?38,"__ BINAURAL",?56,"__ CROS",?69,"__ BICROS"
D LINE
W !,"12. Authorized Usage of Aids",?38,"__ MONAURAL",?56,"__ BINAURAL"
D LINE
W !,"13. Issued aids to be replaced to clinic stock by DDC:",?58,"__ YES",?66,"__ NO",?73,"__ N/A"
D LINE
W !,"14. Signature of Issuing Audiologist",?38,"|",?44,"Name and Title",?65,"|15. Order Date"
W !?38,"|",?65,"|",!?38,"|",?65,"|"
D LINE
I IOST?1"P-".E,$Y>58 W @IOF
W !,"16. I certify that I have",?37,"Signature of Veteran",?65,"|17. Date"
W !?4,"received the item(s)",?65,"|"
W !?4,"listed under 10 above ->",?65,"|"
D LINE
W !,"VA Form 10-2477a"
W !,"SEP 1991"
D CONT G END:$D(RMPFOUT) W:IOST?1"P-".E @IOF
D:$D(IO("S")) ^%ZISC
END K RMPFRSTA,RMPFR,RMPFS,RMPFRSTA,RMPFS,RMPFR,%DT,I,IN,Y,RMPFOUT,RMPFQUT,RMPFCNT Q
READ K RMPFOUT,RMPFQUT
R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
I Y?1"^".E S (RMPFOUT,Y)="" Q
S:Y?1"?".E (RMPFQUT,Y)=""
Q
LINE W !,"--------------------------------------------------------------------------------"
Q
CONT Q:IOST'["C-" F I=1:1 Q:$Y>21 W !
W !,"Enter <RETURN> to continue:" D READ Q:$D(RMPFOUT)
I $D(RMPFQUT) W !!,"Enter <RETURN> to continue or <^> to exit." G CONT
W @IOF Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFQP2 3556 printed Nov 22, 2024@17:46:50 Page 2
RMPFQP2 ;DDC/KAW-PRINT VA FORM 10-2477a; [ 06/16/95 3:06 PM ]
+1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
RMPFSET ;;RMPFMENU must be defined
IF '$DATA(RMPFMENU)
DO MENU^RMPFUTL
IF '$DATA(RMPFMENU)
WRITE !!,$CHAR(7),"*** A MENU SELECTION MUST BE MADE ***"
QUIT
+1 IF '$DATA(RMPFSTAN)!'$DATA(RMPFDAT)!'$DATA(RMPFSYS)
DO ^RMPFUTL
if '$DATA(RMPFSTAN)!'$DATA(RMPFDAT)!'$DATA(RMPFSYS)
QUIT
+2 ;; input: None
+3 ;;output: None
+4 FOR KX=1:1:RMPFCNT
DO PRINT
+5 GOTO END
PRINT DO ^RMPFQP1
+1 if $Y>0
WRITE @IOF
WRITE !?25,"DEPARTMENT OF VETERANS AFFAIRS"
+2 WRITE !?21,"AUDIOLOGICAL SERVICES ACKNOWLEDGEMENT"
+3 DO LINE
+4 WRITE !,"1. Extended Audiology Clinic",?38,"| 2. Issuing Audiology Clinic"
+5 WRITE !?3,"Station No. ",RMPFRSTA,?38,"|",?45,"Station No. ",RMPFSTAP
+6 WRITE !?38,"|"
+7 FOR I=1:1:4
WRITE !
if $DATA(RMPFR(I))
WRITE ?3,$EXTRACT(RMPFR(I),1,32)
WRITE ?38,"|"
if $DATA(RMPFS(I))
WRITE ?45,$EXTRACT(RMPFS(I),1,36)
+8 DO LINE
NAM WRITE !,"3. Veteran's Name and Address ",?38,"| 4. Eligibility Status(es) "
+1 WRITE !,?38,"|"
+2 WRITE !
WRITE ?38,"| __ SC for Hearing",?61,"__ IN PAT"
+3 WRITE !
WRITE ?38,"| __ 50-100% SC",?61,"__ NHCU"
+4 WRITE !
WRITE ?38,"| __ POW",?61,"__ DOM"
+5 WRITE !
WRITE ?38,"| __ WWI",?61,"__ OPT-NSC"
+6 WRITE !
WRITE ?38,"| __ MBW",?61,"__ ADJ"
+7 WRITE !?38,"| __ A&A",?54,"__ ALLIED (Authority Req.)"
+8 WRITE !?38,"| __ HB",?54,"__ OTHER (Specify)"
+9 DO LINE
+10 DO CONT
if $DATA(RMPFOUT)
GOTO END
if IOST?1"C-".E
DO LINE
+11 WRITE !,"5. Soc. Security No.",?16,"| 6. VA Claim No.",?38,"| 7. Date of Birth",?59,"| 8. Disability Code"
+12 WRITE !?20,"|",?38,"|",?59,"|"
+13 WRITE !," - -",?20,"| - -",?38,"|",?59,"| __DEAF/U __DEAF/B"
+14 DO LINE
AUTH WRITE !,"9. Currently Authorized Hearing Aid(s)"
+1 DO LINE
+2 WRITE !?2,"Manfacturer",?16,"|",?22,"Model",?32,"|",?34,"Serial Number",?48,"|",?50,"Furnished By",?64,"|",?67,"Date Issued"
+3 DO LINE
+4 FOR I=1:1:4
WRITE !,?16,"|",?32,"|",?48,"|",?64,"|"
DO LINE
CLINIC WRITE !,"10. Clinic Action Taken __ VETERAN DOES NOT REQUIRE NEW HEARING AID"
+1 WRITE !?27,"__ VETERAN DOES NOT REQUIRE HEARING AID"
+2 WRITE !?27,"__ ITEM(S) LISTED BELOW WERE ISSUED TO VETERAN"
+3 DO LINE
+4 DO CONT
if $DATA(RMPFOUT)
GOTO END
if IOST?1"C-".E
DO LINE
+5 WRITE !,?16,"|",?27,"|",?44,"|",?57,"| Battery",?67,"| Serial No."
+6 WRITE !,"Natl. Stock No.",?16,"|",?20,"Make",?33,"Model"
+7 WRITE ?44,"| Serial No.",?57,"| Type",?67,"| Replaced"
+8 DO LINE
+9 FOR I=1:1:2
WRITE !,"6515-01-",?16,"|",?27,"|",?44,"|",?57,"|",?67,"|"
DO LINE
+10 DO CONT
if $DATA(RMPFOUT)
GOTO END
if IOST?1"C-".E
DO LINE
+11 WRITE !,"11. Type of Fitting",?24,"__ MONAURAL",?38,"__ BINAURAL",?56,"__ CROS",?69,"__ BICROS"
+12 DO LINE
+13 WRITE !,"12. Authorized Usage of Aids",?38,"__ MONAURAL",?56,"__ BINAURAL"
+14 DO LINE
+15 WRITE !,"13. Issued aids to be replaced to clinic stock by DDC:",?58,"__ YES",?66,"__ NO",?73,"__ N/A"
+16 DO LINE
+17 WRITE !,"14. Signature of Issuing Audiologist",?38,"|",?44,"Name and Title",?65,"|15. Order Date"
+18 WRITE !?38,"|",?65,"|",!?38,"|",?65,"|"
+19 DO LINE
+20 IF IOST?1"P-".E
IF $Y>58
WRITE @IOF
+21 WRITE !,"16. I certify that I have",?37,"Signature of Veteran",?65,"|17. Date"
+22 WRITE !?4,"received the item(s)",?65,"|"
+23 WRITE !?4,"listed under 10 above ->",?65,"|"
+24 DO LINE
+25 WRITE !,"VA Form 10-2477a"
+26 WRITE !,"SEP 1991"
+27 DO CONT
if $DATA(RMPFOUT)
GOTO END
if IOST?1"P-".E
WRITE @IOF
+28 if $DATA(IO("S"))
DO ^%ZISC
END KILL RMPFRSTA,RMPFR,RMPFS,RMPFRSTA,RMPFS,RMPFR,%DT,I,IN,Y,RMPFOUT,RMPFQUT,RMPFCNT
QUIT
READ KILL RMPFOUT,RMPFQUT
+1 READ Y:DTIME
IF '$TEST
WRITE $CHAR(7)
READ Y:5
if Y="."
GOTO READ
if '$TEST
SET Y=U
+2 IF Y?1"^".E
SET (RMPFOUT,Y)=""
QUIT
+3 if Y?1"?".E
SET (RMPFQUT,Y)=""
+4 QUIT
LINE WRITE !,"--------------------------------------------------------------------------------"
+1 QUIT
CONT if IOST'["C-"
QUIT
FOR I=1:1
if $Y>21
QUIT
WRITE !
+1 WRITE !,"Enter <RETURN> to continue:"
DO READ
if $DATA(RMPFOUT)
QUIT
+2 IF $DATA(RMPFQUT)
WRITE !!,"Enter <RETURN> to continue or <^> to exit."
GOTO CONT
+3 WRITE @IOF
QUIT
