60 lines
4.6 KiB
Mathematica
60 lines
4.6 KiB
Mathematica
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
|