RMPRPAT5 ;PHX/RFM-DISPLAY/PRINT CRITICAL COMMENTS ;8/29/1994
;;3.0;PROSTHETICS;**20**;Feb 09, 1996
I '$D(RMPRDFN) D GETPAT^RMPRUTIL
W:$E(IOST)["C" @IOF I '$D(^RMPR(665,RMPRDFN,8,1,0)) W !,"PATIENT: ",$P(^DPT(RMPRDFN,0),U),?60,"CRITICAL COMMENTS",!!,"No Patient Critical Comments Recorded for this patient!",!! S RMPRCCO=1 G CRI
W !,"PATIENT: ",$P(^DPT(RMPRDFN,0),U),?60,"CRITICAL COMMENTS",!!
S RO=0 F S RO=$O(^RMPR(665,RMPRDFN,8,RO)) Q:RO="" D WRI
CRI S %=2 W !!,"Would you like to Add/Edit Patient Critical Comments" D YN^DICN W:%=0 !,"Enter `YES or `NO`" G CRI:%=0,EXIT^RMPRPAT:$D(DTOUT),EDIT:%=1 I %=2!(%=-1) W @IOF G ASK1^RMPRPAT
WRI W !,^RMPR(665,RMPRDFN,8,RO,0) Q
EDIT I $D(RMPRCCO) S DIE=665,DA=RMPRDFN,DR=30 D ^DIE G RMPRPAT5
K DIC S DIC="^RMPR(665,RMPRDFN,8," D EN^DIWE G RMPRPAT5
Q
DIS Q:'$D(RMPRDFN) I $D(RMPRDD) K RMPRDD Q
W $C(7),$C(7),!!,"Disability Code has not been entered for this Patient! You must enter a"
W !,"Prosthetic Disability Code to continue." D EN^RMPRDIS I '$D(^RMPR(665,RMPRDFN,1,0)) S RMPRKILL=1 Q
I $D(^RMPR(665,RMPRDFN,1,0)),'$O(^(0)) S RMPRKILL=1 Q
DISP ;DISPLAY DISABILITY CODES
Q:'$D(^RMPR(665,RMPRDFN,1,0)) I '$O(^(0)) Q
W !!,"Current Disability Codes are: "
W ! S RO=0 F I=1:1 S RO=$O(^RMPR(665,RMPRDFN,1,RO)) Q:RO'>0!($D(RMPRQ)) D WRI1
Q
WRI1 I I>4 W !!,"*More Disability Codes on File, See Screen 1" S RMPRQ=1 Q
I $D(^RMPR(662,$P(^RMPR(665,RMPRDFN,1,RO,0),U,1),0)) W !,$P(^(0),U,1) D
.S J=$P(^RMPR(665,RMPRDFN,1,RO,0),U,4)
.W ?15,$S(J=1:"SC VIETNAM",J=2:"ALL OTHER S/C",J=3:"NSC A&A",J=4:"OTHERS ELIG",J=5:"V.I.S.T.",J=6:"VOC REHAB",J=7:"PHC",J=8:"INPATIENT",J=9:"EMPLOYEE",J=10:"PRIMA FACIA",1:"UNK")
.W ?30,$S($P(^RMPR(665,RMPRDFN,1,RO,0),U,3)=1:"S/C",$P(^(0),U,3)=2:"NSC",1:"UNK")
.S J=$P(^RMPR(665,RMPRDFN,1,RO,0),U,5)
.W ?36,$S(J=1:"PL-96-151",J=2:"PL-91-500",J=3:"PL-97-37",J=4:"PL-94-581",J=5:"HOUSEBOUND",J=6:"PL-91-102",J=7:"PL-91-666",J=8:"PL-104-262 (ELIG. REFORM",1:"")
I $P(^RMPR(665,RMPRDFN,1,RO,0),U,10) W ?50,"Deleted..."
Q
NPC ;CHECK ALL DISABILITY CODES MARKED DELETED
K RA F RI=0:0 S RI=$O(^RMPR(665,RMPRDFN,1,RI)) Q:RI'>0 I $D(^(RI,0)) S RA=1 I '$P(^(0),U,10) K RA Q
I $D(RA) W !!,$C(7),?5,"The Patient's Disability Codes have been Marked as Deleted.",!,?5,"No Purchasing may be done for this patient" S RMPRKILL=1 H 3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPAT5 2344 printed Oct 16, 2024@18:36:18 Page 2
RMPRPAT5 ;PHX/RFM-DISPLAY/PRINT CRITICAL COMMENTS ;8/29/1994
+1 ;;3.0;PROSTHETICS;**20**;Feb 09, 1996
+2 IF '$DATA(RMPRDFN)
DO GETPAT^RMPRUTIL
+3 if $EXTRACT(IOST)["C"
WRITE @IOF
IF '$DATA(^RMPR(665,RMPRDFN,8,1,0))
WRITE !,"PATIENT: ",$PIECE(^DPT(RMPRDFN,0),U),?60,"CRITICAL COMMENTS",!!,"No Patient Critical Comments Recorded for this patient!",!!
SET RMPRCCO=1
GOTO CRI
+4 WRITE !,"PATIENT: ",$PIECE(^DPT(RMPRDFN,0),U),?60,"CRITICAL COMMENTS",!!
+5 SET RO=0
FOR
SET RO=$ORDER(^RMPR(665,RMPRDFN,8,RO))
if RO=""
QUIT
DO WRI
CRI SET %=2
WRITE !!,"Would you like to Add/Edit Patient Critical Comments"
DO YN^DICN
if %=0
WRITE !,"Enter `YES or `NO`"
if %=0
GOTO CRI
if $DATA(DTOUT)
GOTO EXIT^RMPRPAT
if %=1
GOTO EDIT
IF %=2!(%=-1)
WRITE @IOF
GOTO ASK1^RMPRPAT
WRI WRITE !,^RMPR(665,RMPRDFN,8,RO,0)
QUIT
EDIT IF $DATA(RMPRCCO)
SET DIE=665
SET DA=RMPRDFN
SET DR=30
DO ^DIE
GOTO RMPRPAT5
+1 KILL DIC
SET DIC="^RMPR(665,RMPRDFN,8,"
DO EN^DIWE
GOTO RMPRPAT5
+2 QUIT
DIS if '$DATA(RMPRDFN)
QUIT
IF $DATA(RMPRDD)
KILL RMPRDD
QUIT
+1 WRITE $CHAR(7),$CHAR(7),!!,"Disability Code has not been entered for this Patient! You must enter a"
+2 WRITE !,"Prosthetic Disability Code to continue."
DO EN^RMPRDIS
IF '$DATA(^RMPR(665,RMPRDFN,1,0))
SET RMPRKILL=1
QUIT
+3 IF $DATA(^RMPR(665,RMPRDFN,1,0))
IF '$ORDER(^(0))
SET RMPRKILL=1
QUIT
DISP ;DISPLAY DISABILITY CODES
+1 if '$DATA(^RMPR(665,RMPRDFN,1,0))
QUIT
IF '$ORDER(^(0))
QUIT
+2 WRITE !!,"Current Disability Codes are: "
+3 WRITE !
SET RO=0
FOR I=1:1
SET RO=$ORDER(^RMPR(665,RMPRDFN,1,RO))
if RO'>0!($DATA(RMPRQ))
QUIT
DO WRI1
+4 QUIT
WRI1 IF I>4
WRITE !!,"*More Disability Codes on File, See Screen 1"
SET RMPRQ=1
QUIT
+1 IF $DATA(^RMPR(662,$PIECE(^RMPR(665,RMPRDFN,1,RO,0),U,1),0))
WRITE !,$PIECE(^(0),U,1)
Begin DoDot:1
+2 SET J=$PIECE(^RMPR(665,RMPRDFN,1,RO,0),U,4)
+3 WRITE ?15,$SELECT(J=1:"SC VIETNAM",J=2:"ALL OTHER S/C",J=3:"NSC A&A",J=4:"OTHERS ELIG",J=5:"V.I.S.T.",J=6:"VOC REHAB",J=7:"PHC",J=8:"INPATIENT",J=9:"EMPLOYEE",J=10:"PRIMA FACIA",1:"UNK")
+4 WRITE ?30,$SELECT($PIECE(^RMPR(665,RMPRDFN,1,RO,0),U,3)=1:"S/C",$PIECE(^(0),U,3)=2:"NSC",1:"UNK")
+5 SET J=$PIECE(^RMPR(665,RMPRDFN,1,RO,0),U,5)
+6 WRITE ?36,$SELECT(J=1:"PL-96-151",J=2:"PL-91-500",J=3:"PL-97-37",J=4:"PL-94-581",J=5:"HOUSEBOUND",J=6:"PL-91-102",J=7:"PL-91-666",J=8:"PL-104-262 (ELIG. REFORM",1:"")
End DoDot:1
+7 IF $PIECE(^RMPR(665,RMPRDFN,1,RO,0),U,10)
WRITE ?50,"Deleted..."
+8 QUIT
NPC ;CHECK ALL DISABILITY CODES MARKED DELETED
+1 KILL RA
FOR RI=0:0
SET RI=$ORDER(^RMPR(665,RMPRDFN,1,RI))
if RI'>0
QUIT
IF $DATA(^(RI,0))
SET RA=1
IF '$PIECE(^(0),U,10)
KILL RA
QUIT
+2 IF $DATA(RA)
WRITE !!,$CHAR(7),?5,"The Patient's Disability Codes have been Marked as Deleted.",!,?5,"No Purchasing may be done for this patient"
SET RMPRKILL=1
HANG 3
