RMPRPAT0 ;Hines IOFO/RFM,DDA - PATIENT INQUIRY SCREEN FROM MAS ;3/26/07 07:47
;;3.0;PROSTHETICS;**88**;Feb 09, 1996;Build 2
;DDA 13 FEB 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.
;
N VAHOW
Q:$G(RMPRDFN)'>0 K RMPRQUES S DFN=RMPRDFN,VAIP("D")="L" D DEM^VADPT,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
W "DOB: ",$P(VADM(3),U,2),?61,"CLAIM# ",$G(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=1:1 S RO=$O(^UTILITY("VAEN",$J,RO)) Q:RO'>0!($D(KILL)) D WRI
G APP
WRI I I=3 S %=2 W !,"Would you like to see more clinics" D YN^DICN I %=-1!(%=2) S KILL=1 Q
I I=3,%=0 W !,"Enter `YES` or `NO`" G 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 S RMPRCOMB=1 D DIRT D ^RMPRFO2 G EXIT
. 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 K KILL F I=1:1 S RO=$O(^UTILITY("VASD",$J,RO)) Q:RO'>0!($D(KILL)) D WRI2
S RMPRCOMB=1 D DIRT D ^RMPRFO2
G EXIT
WRI2 W:'$D(RMPRFLL) !,"Appt. Date",?20,"Clinic",?50,"Status",?60,"Type" S RMPRFLL=1
APPA I I=3 S %=2 W !,"Would you like to see more appointments" D YN^DICN I %=-1!(%=2)!($D(DTOUT)) S KILL=1 Q
I I=3,%=0 W !,"Answer `YES` or `NO`" G APPA
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),^UTILITY("VASD",$J),RO,VAIP,VASD,RMPRFLL,KILL,RMPRFLG,RMPRSDER W ! G ASK2^RMPRPAT
Q
DIRT N DIR S DIR(0)="E" D ^DIR I Y'>0 G EXIT Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPAT0 2612 printed Sep 23, 2025@20:11:46 Page 2
RMPRPAT0 ;Hines IOFO/RFM,DDA - PATIENT INQUIRY SCREEN FROM MAS ;3/26/07 07:47
+1 ;;3.0;PROSTHETICS;**88**;Feb 09, 1996;Build 2
+2 ;DDA 13 FEB 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 NEW VAHOW
+7 if $GET(RMPRDFN)'>0
QUIT
KILL RMPRQUES
SET DFN=RMPRDFN
SET VAIP("D")="L"
DO DEM^VADPT
DO IN5^VADPT
DO SDE^VADPT
KILL VAERR
DO SDA^VADPT
SET RMPRSDER=VAERR
WRITE @IOF
+8 WRITE !,$EXTRACT(RMPRNAM,1,20),?23,"SSN: ",$PIECE(VADM(2),U,2),?42
+9 WRITE "DOB: ",$PIECE(VADM(3),U,2),?61,"CLAIM# ",$GET(RMPRCNUM)
+10 WRITE !!?20,"Last Movement Actions",!
IF VAIP(1)=""
WRITE !?5,"No Movements Recorded for this Patient",!!
GOTO CLI
+11 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)
+12 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)
+13 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=1:1
SET RO=$ORDER(^UTILITY("VAEN",$JOB,RO))
if RO'>0!($DATA(KILL))
QUIT
DO WRI
+2 GOTO APP
WRI IF I=3
SET %=2
WRITE !,"Would you like to see more clinics"
DO YN^DICN
IF %=-1!(%=2)
SET KILL=1
QUIT
+1 IF I=3
IF %=0
WRITE !,"Enter `YES` or `NO`"
GOTO WRI
+2 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
SET RMPRCOMB=1
DO DIRT
DO ^RMPRFO2
GOTO EXIT
+4 SET RO=0
KILL KILL
FOR I=1:1
SET RO=$ORDER(^UTILITY("VASD",$JOB,RO))
if RO'>0!($DATA(KILL))
QUIT
DO WRI2
+5 SET RMPRCOMB=1
DO DIRT
DO ^RMPRFO2
+6 GOTO EXIT
WRI2 if '$DATA(RMPRFLL)
WRITE !,"Appt. Date",?20,"Clinic",?50,"Status",?60,"Type"
SET RMPRFLL=1
APPA IF I=3
SET %=2
WRITE !,"Would you like to see more appointments"
DO YN^DICN
IF %=-1!(%=2)!($DATA(DTOUT))
SET KILL=1
QUIT
+1 IF I=3
IF %=0
WRITE !,"Answer `YES` or `NO`"
GOTO APPA
+2 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),^UTILITY("VASD",$JOB),RO,VAIP,VASD,RMPRFLL,KILL,RMPRFLG,RMPRSDER
WRITE !
GOTO ASK2^RMPRPAT
+1 QUIT
DIRT NEW DIR
SET DIR(0)="E"
DO ^DIR
IF Y'>0
GOTO EXIT
QUIT
