RMPRDIS ;PHX/JLT-DISPLAY/EDIT DISABILITY CODES
 ;;3.0;PROSTHETICS;;Feb 09, 1996
 D GETPAT^RMPRUTIL Q:'$D(RMPRDFN)
EN ;ADD DISABILITY CODE, CALLED FROM RMPRAP
 N DIC,DIR
 I $D(RMPRDIR7) S DIR(0)="Y",DIR("A")="Would you like to ADD/EDIT a Disability Code to the Patient's 2319",DIR("B")="YES",DIR("?")="Enter 'Y' to Edit a Disability Code, 'N' or '^' to continue."
 I  D ^DIR G:$D(DIRUT)!($D(DUOUT)) END G:+Y=0 DEA
 I $G(RMPRDA) S DFN=$P($G(^RMPR(660.5,RMPRDA,0)),U,2) I +DFN,'$D(^RMPR(665,+DFN)) S ^RMPR(665,DFN,0)=DFN_U_RMPR("STA") S DA=DFN,DIK="^RMPR(665," D IX1^DIK
 I '$D(^RMPR(665,RMPRDFN,1)) S ^RMPR(665,RMPRDFN,1,0)="^665.01PI^0^0"
 D:'$D(RMPRBACK) LP L +^RMPR(665,RMPRDFN,1):1 I $T=0 W !,$C(7),?5,"Someone else is Editing this entry" G END
AMP W ! S DA(1)=RMPRDFN,DIC="^RMPR(665,"_DA(1)_",1,",DIC(0)="AEQMZL",DLAYGO=665,DIC("W")="S RA=^(0) D DSP^RMPRDIS" D ^DIC K DLAYGO G:+Y'>0 DEND S RMPRY=Y,RMPRX=$P(Y,U,2)
 I $P(^RMPR(665,RMPRDFN,1,+Y,0),U,10) S DIR(0)="Y",DIR("A",1)="DISABILITY CODE HAS BEEN MARKED AS DELETED.",DIR("A")="WOULD YOU LIKE TO RE-ACTIVATED THIS CODE",DIR("B")="NO",DIR("?")="Enter 'Y' to re-activate code."
 I  D ^DIR G:$D(DIRUT)!($D(DUOUT)) DEND K DIR I +Y=1 S DA=+RMPRY,DIE=DIC,DR="10///@" D ^DIE
 S RC=0 F RI=0:0 S RI=$O(^RMPR(665,RMPRDFN,1,"B",RMPRX,RI)) Q:RI'>0  S RC=RC+1
 I RC'>1 K DIRUT D DIR G:$D(DIRUT) AMP
EDIT K DIR S DIE="^RMPR(665,RMPRDFN,1,",DA(1)=RMPRDFN,DA=+RMPRY D SDR
 D ^DIE I $D(DA),$P(^RMPR(665,DA(1),1,DA,0),U,4)'=4 S $P(^(0),U,5)=""
 I $D(DA) I '$P(^RMPR(665,RMPRDFN,1,DA,0),U,3)!'$P(^(0),U,4) S DA(1)=RMPRDFN,DIK="^RMPR(665,RMPRDFN,1,",DA(1)=RMPRDFN D ^DIK W !,?5,$C(7),"Deleted..."
 G AMP
DEND L -^RMPR(665,RMPRDFN,1) K RMPRX,RMPRY,RT,RI,RA,RMPRT,RCC
 I '$D(RMPRBACK) K DIC,Y,RMPRD,DIE,DR Q
DEA ;DEACTIVATE PATIENT PROSTHETICS DISABILITY CODES
 ;I $G(RMPRDFN)'>0 Q
 Q:$D(RMPRDIR3)  I '$D(RMPRBACK) K RMPRDFN D GETPAT^RMPRUTIL G:'$D(RMPRDFN) END
 Q:$G(RMPRDFN)'>0
 I '$D(^RMPR(665,RMPRDFN,1))!($O(^RMPR(665,RMPRDFN,1,0))'>0) W !!,"Patient has no Prosthetics Disability codes",$C(7) G END
 W !,$P(^DPT(RMPRDFN,0),U,1)," HAS THE FOLLOWING DISABILITY CODES:",! F RI=0:0 S RI=$O(^RMPR(665,RMPRDFN,1,RI)) Q:RI'>0  S RA=^(RI,0) W !,?5,$P(^RMPR(662,$P(RA,U,1),0),U,1) D DSP
 I $D(RMPRDIR7) W !! S DIR(0)="Y",DIR("A")="Would you like to Mark a Disability Code as Deleted",DIR("B")="NO",DIR("?")="Enter 'Y' to Mark a Disability Code as Deleted" D ^DIR G:$D(DIRUT)!($D(DUOUT))!(+Y=0) END
 S RA=0 F RI=0:1 S RA=$O(^RMPR(665,RMPRDFN,1,RA)) Q:RA'>0
 I RI'>1 G SEL
 K DIR W !! S DIR(0)="Y"
 S DIR("A")="Would you like to Mark all of the Patient's Disability Codes as Deleted",DIR("B")="NO",DIR("?")="Enter 'Y' to Mark all of the Patients Disability Codes as Deleted, 'N' to select a Disability Code."
 D ^DIR G:$D(DIRUT)!($D(DUOUT)) END I +Y=0 G SEL
 L +^RMPR(665,RMPRDFN,1):1 I $T=0 W !,$C(7),?5,"Someone else is Editing this entry!" G END
 F RI=0:0 S RI=$O(^RMPR(665,RMPRDFN,1,RI)) Q:RI'>0  I $D(^(RI,0)) S DA=RI,DIE="^RMPR(665,"_RMPRDFN_",1,",DR="5///^S X=2;10///^S X=DT",DA(1)=RMPRDFN D ^DIE
 L -^RMPR(665,RMPRDFN,1)
END K RMPRX,RMPRY,RA,RI,RT,RC,RMPRT I $D(RMPRDIR3) Q
 I $D(RMPRDIR7) K RMPRDIR7 G ASK1^RMPRPAT
 Q:$D(RMPRBACK)  K RMPRDFN,RMPRSSN,RMPRNAM,RMPRDOB,RMPRD,DIE,DIR,DR,DIRUT,DIC,DIK,DA Q
SEL W ! S DIC="^RMPR(665,"_RMPRDFN_",1,"
 S DIC(0)="AEQMZ",DIC("W")="S RA=^(0) D DSP^RMPRDIS"
 D ^DIC G:+Y'>0&('$D(RMPRBACK)) DEA G:+Y'>0 END
 L +^RMPR(665,RMPRDFN,1):1 I $T=0 W !,$C(7),?5,"Someone else is Editing this entry!" G END
 S DA=+Y,DA(1)=RMPRDFN,DIE=DIC,DR="5///^S X=2;10///^S X=DT" D ^DIE L -^RMPR(665,RMPRDFN,1) W !,?5,"**CODE MARKED AS DELETED**" W ! G SEL
LP ;DISPLAY DISABILITY CODES
 K RMPRD F RI=0:0 S RI=$O(^RMPR(665,RMPRDFN,1,RI)) Q:RI'>0  I $D(^(RI,0)) S RMPRD(RI)=^(0)
 W ! I $D(RMPRD) W !,$P(^DPT(RMPRDFN,0),U)," HAS THE FOLLOWING CODES:",! F RI=0:0 S RI=$O(RMPRD(RI)) Q:RI'>0  S RA=RMPRD(RI) W !,?5,$P(^RMPR(662,$P(RA,U),0),U) D DSP
 Q
DIR K DIR I '$P(RMPRY,U,3) S DIR(0)="S^E:EDIT DISABILITY CODE;A:ADD DUPLICATE DISABILITY CODE",DIR("B")="EDIT" D ^DIR Q:$D(DIRUT)  I Y["A" D FILE
 Q
FILE K DD,DO,D0 S DIC="^RMPR(665,"_RMPRDFN_",1,",DIC(0)="EQML",DLAYGO=665 S X=RMPRX D FILE^DICN K DLAYGO S DA(1)=RMPRDFN,RMPRY=+Y Q
DSP I +$P(RA,U,3) W ?15 W $S($P(RA,U,3)=1:"SC ",1:"NSC ")
 I +$P(RA,U,4) S RT=$P(^DD(665.01,3,0),U,3) W ?21,$P($P(RT,":",$P(RA,U,4)+1),";",1)_" "
 I +$P(RA,U,5) S RT=$P(^DD(665.01,4,0),U,3) W ?41,$P($P(RT,":",$P(RA,U,5)+1),";",1)
 I +$P(RA,U,10) W ?65,"Deleted..."
 Q
SDR S DR=".01;5///1;2;3;S $P(^RMPR(665,DA(1),1,DA,0),U,8)=DUZ;1///^S X=DT;10///@;I $P(^RMPR(665,DA(1),1,DA,0),U,4)'=4 S Y="""";4" Q
CHK S RDA=$P(^RMPR(665,DA(1),1,DA,0),U) D  K RDA
 .F RI=0:0 S RI=$O(^RMPR(665,DA(1),1,"B",RDA,RI)) Q:RI'>0  S RV=$P(^RMPR(665,DA(1),1,RI,0),U,3) I (X=RV),(DA'=RI) K X Q