RMPRELG2.m

RMPRELG2 ;Hines IOFO/RFM,DDA - DISPLAY ELIGIBILITY SECOND PAGE ;3/26/07  07:39

 ;;3.0;PROSTHETICS;**88**;Feb 09, 1996;Build 2

 ;DDA 6 MAR 07 - Patch 88 - Added Scheduling Encapsulation database check

 ; for SDA^VADPT call and ^UTILITY("VASD", usage.

 ; Variable RMPRSDER will equal 2 if the COTS database is unavailable.

 ;

 S VAIP("D")="L" D IN5^VADPT,SDE^VADPT K VAERR D SDA^VADPT S RMPRSDER=VAERR W @IOF

 W $E(RMPRNAM,1,20),?23,"SSN: ",$P(VADM(2),U,2),?42,"DOB: ",$P(VADM(3),U,2),?61,"CLAIM# ",RMPRCNUM

 W !!?20,"Last Movement Actions",! I VAIP(1)="" W !?5,"No Movements Recorded for this Patient",!! G CLI

 W "Trans. Type: ",$P(VAIP(2),U,2),?40,"Trans. Type: ",$P(VAIP(13,2),U,2),!,"Date: ",$P(VAIP(3),U,2),?40,"Date: ",$P(VAIP(13,1),U,2),!,"Type of Movement: ",?40,"Type of Movement: ",!,$P(VAIP(4),U,2),?40,$P(VAIP(13,3),U,2)

 W !,"Ward: ",$P(VAIP(5),U,2),?40,"Ward: ",$P(VAIP(13,4),U,2),!,"Physician: ",$E($P(VAIP(7),U,2),1,25),?40,"Physician: ",$E($P(VAIP(13,5),U,2),1,25)

 W !,"Diagnosis: ",$E(VAIP(9),1,28),?40,"Diagnosis: ",$E(VAIP(9),1,28)

CLI W !?20,"Clinic Enrollments" I '$D(^UTILITY("VAEN",$J)) W !!?5,"No Clinic Enrollments for this Patient" G APP

 S RO=0 F I=0:0 S RO=$O(^UTILITY("VAEN",$J,RO)) Q:RO'>0  D WRI

 G APP

WRI W:'$D(RMPRFLG) !,"Clinic",?40,"Enrollment Date",?60,"OPT or AC" S RMPRFLG=1 W !,$P(^UTILITY("VAEN",$J,RO,"E"),U,1),?40,$P(^UTILITY("VAEN",$J,RO,"E"),U,2),?63,$P(^UTILITY("VAEN",$J,RO,"E"),U,3) Q

APP W !!,?20,"Pending Appointments" I RMPRSDER=2!'$D(^UTILITY("VASD",$J)) D  G VIEW

 . I RMPRSDER=2 W !!?5,"Fatal RSA error. See SDAM RSA ERROR LOG file." Q

 . W !!?5,"No Pending Appointments for this Patient"

 .Q

 S RO=0 F I=0:0 S RO=$O(^UTILITY("VASD",$J,RO)) Q:RO'>0  D WRI2

VIEW S RMPRCOMB=1,RNSK=1 D:$D(DFN) DIV4^RMPRSIT,^RMPRFO2

 G EXIT

WRI2 W:'$D(RMPRFLL) !,"Appt. Date",?20,"Clinic",?50,"Status",?60,"Type" S RMPRFLL=1

 W !,$P(^UTILITY("VASD",$J,RO,"E"),U,1),?20,$E($P(^UTILITY("VASD",$J,RO,"E"),U,2),1,29),?50,$P(^UTILITY("VASD",$J,RO,"E"),U,3),?60,$P(^UTILITY("VASD",$J,RO,"E"),U,4) Q

EXIT K ^UTILITY("VAEN",$J),RMPRIN,^UTILITY("VASD",$J),RVA,RMPRFF,VAIP,VASD,RO,RMPRFLL,RMPRFLG,RMPRSDER S FL=2 W ! G EXIT^RMPRELG1

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RMPRELG2   2189     printed  Apr 23, 2025@18:48:52                                                                                                                                                                                                    Page 2

RMPRELG2  ;Hines IOFO/RFM,DDA - DISPLAY ELIGIBILITY SECOND PAGE ;3/26/07  07:39

 +1       ;;3.0;PROSTHETICS;**88**;Feb 09, 1996;Build 2

 +2       ;DDA 6 MAR 07 - Patch 88 - Added Scheduling Encapsulation database check

 +3       ; for SDA^VADPT call and ^UTILITY("VASD", usage.

 +4       ; Variable RMPRSDER will equal 2 if the COTS database is unavailable.

 +5       ;

 +6        SET VAIP("D")="L"

           DO IN5^VADPT

           DO SDE^VADPT

           KILL VAERR

           DO SDA^VADPT

           SET RMPRSDER=VAERR

           WRITE @IOF

 +7        WRITE $EXTRACT(RMPRNAM,1,20),?23,"SSN: ",$PIECE(VADM(2),U,2),?42,"DOB: ",$PIECE(VADM(3),U,2),?61,"CLAIM# ",RMPRCNUM

 +8        WRITE !!?20,"Last Movement Actions",!

           IF VAIP(1)=""

               WRITE !?5,"No Movements Recorded for this Patient",!!

               GOTO CLI

 +9        WRITE "Trans. Type: ",$PIECE(VAIP(2),U,2),?40,"Trans. Type: ",$PIECE(VAIP(13,2),U,2),!,"Date: ",$PIECE(VAIP(3),U,2),?40,"Date: ",$PIECE(VAIP(13,1),U,2),!,"Type of Movement: ",?40,"Type of Movement: ",!,$PIECE(VAIP(4),U,2),?40,$PIECE(VAIP(13,3),

U,2)

 +10       WRITE !,"Ward: ",$PIECE(VAIP(5),U,2),?40,"Ward: ",$PIECE(VAIP(13,4),U,2),!,"Physician: ",$EXTRACT($PIECE(VAIP(7),U,2),1,25),?40,"Physician: ",$EXTRACT($PIECE(VAIP(13,5),U,2),1,25)

 +11       WRITE !,"Diagnosis: ",$EXTRACT(VAIP(9),1,28),?40,"Diagnosis: ",$EXTRACT(VAIP(9),1,28)

CLI        WRITE !?20,"Clinic Enrollments"

           IF '$DATA(^UTILITY("VAEN",$JOB))

               WRITE !!?5,"No Clinic Enrollments for this Patient"

               GOTO APP

 +1        SET RO=0

           FOR I=0:0

               SET RO=$ORDER(^UTILITY("VAEN",$JOB,RO))

               if RO'>0

                   QUIT 

               DO WRI

 +2        GOTO APP

WRI        if '$DATA(RMPRFLG)

               WRITE !,"Clinic",?40,"Enrollment Date",?60,"OPT or AC"

           SET RMPRFLG=1

           WRITE !,$PIECE(^UTILITY("VAEN",$JOB,RO,"E"),U,1),?40,$PIECE(^UTILITY("VAEN",$JOB,RO,"E"),U,2),?63,$PIECE(^UTILITY("VAEN",$JOB,RO,"E"),U,3)

           QUIT 

APP        WRITE !!,?20,"Pending Appointments"

           IF RMPRSDER=2!'$DATA(^UTILITY("VASD",$JOB))

               Begin DoDot:1

 +1                IF RMPRSDER=2

                       WRITE !!?5,"Fatal RSA error. See SDAM RSA ERROR LOG file."

                       QUIT 

 +2                WRITE !!?5,"No Pending Appointments for this Patient"

 +3                QUIT 

               End DoDot:1

               GOTO VIEW

 +4        SET RO=0

           FOR I=0:0

               SET RO=$ORDER(^UTILITY("VASD",$JOB,RO))

               if RO'>0

                   QUIT 

               DO WRI2

VIEW       SET RMPRCOMB=1

           SET RNSK=1

           if $DATA(DFN)

               DO DIV4^RMPRSIT

               DO ^RMPRFO2

 +1        GOTO EXIT

WRI2       if '$DATA(RMPRFLL)

               WRITE !,"Appt. Date",?20,"Clinic",?50,"Status",?60,"Type"

           SET RMPRFLL=1

 +1        WRITE !,$PIECE(^UTILITY("VASD",$JOB,RO,"E"),U,1),?20,$EXTRACT($PIECE(^UTILITY("VASD",$JOB,RO,"E"),U,2),1,29),?50,$PIECE(^UTILITY("VASD",$JOB,RO,"E"),U,3),?60,$PIECE(^UTILITY("VASD",$JOB,RO,"E"),U,4)

           QUIT 

EXIT       KILL ^UTILITY("VAEN",$JOB),RMPRIN,^UTILITY("VASD",$JOB),RVA,RMPRFF,VAIP,VASD,RO,RMPRFLL,RMPRFLG,RMPRSDER

           SET FL=2

           WRITE !

           GOTO EXIT^RMPRELG1

 +1        QUIT