- 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 Jan 18, 2025@03:36:49 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