69 lines
3.6 KiB
Mathematica
69 lines
3.6 KiB
Mathematica
MCARGD ;WISC/TJK-DIAGNOSIS FILTER ;3/11/96 12:06
|
|
;;2.3;Medicine;;09/13/1996
|
|
G EXIT:$D(DUOUT)!($D(DTOUT))
|
|
PROC W:$D(MCDFLAG) @IOF W !!?33,"DIAGNOSIS ENTRY",!?33,"--------------",!! S (DIC,DIE)="^MCAR(699,",DA=MCARGDA,MCARTY="Primary" G EDIT:$D(^MCAR(699,MCARGDA,204))
|
|
D ARR G COM:'$D(V)
|
|
PRIM G PRIM1:J>1
|
|
S DIR("A")="Do you wish to enter this diagnosis as the primary diagnosis"
|
|
S DIR("B")="Y",DIR(0)="Y"
|
|
D ^DIR
|
|
G EXIT:$G(DIRUT),SEC:'Y
|
|
S Z=1
|
|
G PRIM2
|
|
PRIM1 W !!,"Enter Primary Diagnosis (1-",J,"): " R Z:DTIME G EXIT:'$T,EXIT:Z=U
|
|
I Z?1"?"."?" W !,*7,"Enter Number of Diagnosis That You Wish to Use as Primary Diagnosis",!,"Hit Return if you do not wish to enter any of above" G PRIM1
|
|
G SEC:Z="" I '$D(V(Z)) W *7," ??" G PRIM1
|
|
PRIM2 S X=V(Z),DR="204///"_X_";205" W !,$P(^MCAR(697.5,X,0),U) D ^DIE G EXIT:$D(DTOUT),EXIT:$D(Y)
|
|
SEC S MCARTY="Secondary" D ARR G COM:'$D(V) K DR
|
|
W !!,"Enter Number of Secondary Diagnosis or 'ALL' to enter all: "
|
|
R Z:DTIME G EXIT:'$T,COM:Z="",EXIT:Z=U I Z="ALL" F ZI=0:0 S ZI=$O(V(ZI)) Q:ZI="" D SECSET
|
|
K ZI G COM:Z="ALL",COM:Z="" I $E(Z)="?" W !,*7,"Enter Number of Diagnosis from above list or enter 'ALL' for All Diagnoses to be entered as a secondary diagnosis."
|
|
I '$D(V(Z)) W *7," ??" G SEC
|
|
S ZI=Z D SECSET K ZI G EXIT:$D(DTOUT),EXIT:$D(Y) G SEC
|
|
COM K DR,DIC,DIE,DA S DIE="^MCAR(699,",DA=MCARGDA,DR="37.1"
|
|
;MFD 3/10/93 ;700",DR(2,699.03)=.01
|
|
D ^DIE G EXIT:$D(DTOUT),EXIT:$D(Y)
|
|
REV G EXIT:'$D(^MCAR(699,MCARGDA,204))
|
|
K DR S DR=38 D ^DIE G EXIT
|
|
EDIT S DR="204;205" D ^DIE G EXIT:$D(DTOUT),EXIT:$D(Y)
|
|
G SEC
|
|
SECSET K DR,DIE,DIC S:'$D(^MCAR(699,MCARGDA,27)) ^(27,0)="^699.75^0^0" S X=$P(^MCAR(697.5,V(ZI),0),U),DA(1)=MCARGDA,DIE="^MCAR(699,"_MCARGDA_",27,"
|
|
I $D(^MCAR(699,MCARGDA,27,"B",V(ZI))) S DA=$O(^(V(ZI),0)),DR=".01;1" G SECSET1
|
|
S DR=".01///"_V(ZI)_";1" F DA=1:1 Q:'$D(^MCAR(699,MCARGDA,27,DA))
|
|
S $P(^MCAR(699,MCARGDA,27,0),U,3)=DA,$P(^(0),U,4)=$P(^(0),U,4)+1
|
|
SECSET1 W !,X D ^DIE Q
|
|
ARR K V,A S J=0
|
|
F I=0:0 S I=$O(^MCAR(699,MCARGDA,30,I)) Q:I'?1N.N I $P(^(I,0),U,6) S K=$P(^(0),U,6) D CHECK,LIST
|
|
Q
|
|
CHECK I '$D(^MCAR(699,MCARGDA,204)) Q
|
|
I $D(^MCAR(699,MCARGDA,204)),^(204)'=K Q
|
|
Q
|
|
LIST I $T,'$D(A(K)) S J=J+1 W:J=1 !!,"Possible ",MCARTY," Diagnoses are: " W !,J,". ",$P(^MCAR(697.5,K,0),U) S V(J)=K,A(K)="" D ENTERED:$E(MCARTY)="S"
|
|
Q
|
|
ENTERED I $D(^MCAR(699,MCARGDA,27,"B",K)) W " ****ENTERED****"
|
|
Q
|
|
DPT ;
|
|
S MCPRO=$S(MCARCODE="P":"PULM",1:"GI")
|
|
D MCEPROC^MCARE
|
|
S DIC="^MCAR(699,",DIC(0)="AEQMZ",MCFILE=699
|
|
S DIC("S")="I $D(^MCAR(697.2,""D"",MCARCODE,$P(^MCAR(699,+Y,0),U,12))),$P(^MCAR(699,+Y,0),U,12)'=$O(^MCAR(697.2,""B"",""NON-ENDO"",0))"
|
|
I MCESON S DIC("S")=$$PREEDIT^MCESSCR(MCFILE)
|
|
S DIC("A")="Select Patient Name or Date/Time of Appointment: "
|
|
D ^DIC K DIC("S"),DIC("A")
|
|
G EXIT:Y<0
|
|
S MCARGDA=+Y,MCARGNUM=$P(Y(0),U,12),MCFILE=699
|
|
I MCESON,("125"'[$$ESTONUM^MCESSCR(MCFILE,MCARGDA)) D ESRC^MCESSCR(MCFILE,MCARGDA) I '$D(MCBACK) G EXIT ;RMP CHANGED () EXPRESSION FROM >2
|
|
I $D(MCBACK) D BACK^MCARGE
|
|
S DFN=$P(Y(0),U,2),MCARGDA=+Y,MCARGNUM=$P(Y(0),U,12),MCARGNAM=$P(^MCAR(697.2,MCARGNUM,0),U)
|
|
D ORDER^MCARGEO G EXIT:$D(DTOUT)!$D(DUOUT)
|
|
D PROC,ORDER1^MCARGEO,QTASK^MCPARAM
|
|
I $G(MCARGDA)>0 S UNSIGNED=$S($P(^MCAR(MCFILE,MCARGDA,"ES"),U,4)="":1,1:0) D POST^MCESEDT(MCFILE,.MCARGDA) D:UNSIGNED=1 ^MCWORKLD
|
|
K MCARGDA,MCARGNUM,MCFILE,MCARGNON,UNSIGNED
|
|
EXIT ;
|
|
K DIC,DIE,DA,I,J,K,V,MCARTY,Z,ZI,A,%,%Y,%Y1,%Y2,C,D,D0,DI,DIPGM,DQ,DR,MCARCODE,X,Y,A,MCPROV Q
|
|
EN1 ;CALLED BY X-REF TO DELETE SECONDARY DIAGNOSIS WHEN IMPRESSION IS DELETED
|
|
N I,J
|
|
S I=$O(^MCAR(699,DA(1),27,"B",X,0)) Q:'I
|
|
K ^MCAR(699,DA(1),27,I),^MCAR(699,DA(1),27,"B",X,I)
|
|
S I=$P(^MCAR(699,DA(1),27,0),U,3),J=$P(^(0),U,4),$P(^(0),U,3)=I-1,$P(^(0),U,4)=J-1 Q
|