- 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 Feb 19, 2025@00:02:04 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