RMPFQP2.m

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 ---RMPFQP2   3556     printed  Mar 13, 2025@21:41:57                                                                                                                                                                                                     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