73 lines
3.6 KiB
Mathematica
73 lines
3.6 KiB
Mathematica
GMRALAB1 ;HIRMFO/WAA-THIS PROGRAM WILL SELECT ALL LAB TEST FOR A PATIENT ;1/9/96 09:48
|
|
;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
|
|
EDIT ;EDIT EXISTING DATA
|
|
I '$O(^GMR(120.85,GMRAPA1,4,0)) W !,?3,"YOU CANNOT EDIT WHEN THERE IS NO DATA ON FILE.",$C(7) Q
|
|
EDITLST ; DISPLAY TO EDIT FIELD
|
|
D LST^GMRALAB0
|
|
EEDT K DA,DO,DIC,DIE,DLAYGO,DR
|
|
S DA(1)=GMRAPA1,DIC="^GMR(120.85,"_DA(1)_",4,",DIC(0)="AMQEZ" D ^DIC K DIC,DLAYGO
|
|
I $D(DUOUT)!($D(DTOUT)) S GMRAOUT=1 Q
|
|
I Y=-1 S GMRAOUT=1 Q
|
|
S DA(1)=GMRAPA1,DIE="^GMR(120.85,"_DA(1)_",4,",DA=+Y,DR=".01;1;2" D ^DIE
|
|
K GMRAX,DA,DIE,DR
|
|
Q
|
|
ADD ;This is to allow the user to select a LAB TEST
|
|
D DISP^GMRALAB0 I GMRAOUT S GMRAOUT=GMRAOUT-1 Q:GMRAOUT
|
|
K % I '$D(^TMP($J,"GMRALAB")) D ADD2 Q:X="" G ADD
|
|
ADDED W !,"Enter the number of the TX/Test to ADD or ""N"" for NEW: "
|
|
R GMRAX:DTIME S:'$T GMRAX="^^" I "^^"[GMRAX S GMRAOUT=$L(GMRAX) Q
|
|
I "??"[GMRAX D:$L(GMRAX)=2 Q:GMRAOUT W !,"ENTER THE NUMBER OF THE ENTRY YOU WANT OR ""N"" FOR A NEW TEST" G ADDED
|
|
.D DISP^GMRALAB0 I GMRAOUT S GMRAOUT=GMRAOUT-1 Q:GMRAOUT
|
|
.Q
|
|
I GMRAX="n" S GMRAX="N"
|
|
I GMRAX="N" D ADD2 Q:X="" G ADD
|
|
I '$$VALST^GMRALAB1(GMRAX,"L") W !,$C(7),"INVALID SELECTION PLEASE SELECT ONE OF THE TEST/TX LISTED OR ""N"" FOR A NEW TEST" G ADD
|
|
S GMRALST=0 F S GMRALST=$O(GMRALST(GMRALST)) Q:GMRALST<1 S GMRAX=GMRALST D Q:GMRAOUT
|
|
.S X=$E($P(^TMP($J,"GMRALAB","L",GMRAX),U,3),1,18)
|
|
.I $D(^GMR(120.85,GMRAPA1,4,"B",X)) D Q:GMRAOUT!(%-1) K %
|
|
..W !,"You already have a ",X," test on file."
|
|
..S %=2 F W !,"Do You still want to add this one" D YN^DICN S:%=-1 %=2,GMRAOUT=1 Q:% W !,"ENTER YES TO ADD THE TEST/TX OR NO TO SELECT ANOTHER"
|
|
..Q
|
|
.K DD,DO
|
|
.I '$D(^GMR(120.85,GMRAPA1,4,0)) S ^(0)="^120.8504^^"
|
|
.S DA(1)=GMRAPA1,DIC="^GMR(120.85,"_GMRAPA1_",4,",DIC(0)="L",DLAYGO=120.85 D FILE^DICN K DLAYGO Q:(+Y<1)
|
|
.S GMRARSLT=$E($P($P(^TMP($J,"GMRALAB","L",GMRAX),U,4),"|"),1,78)_" "_$E($P(^TMP($J,"GMRALAB","L",GMRAX),U,6),1,10)
|
|
.I $P(^TMP($J,"GMRALAB","L",GMRAX),U,8)'="" S GMRARSLT=GMRARSLT_" H:"_$E($P(^TMP($J,"GMRALAB","L",GMRAX),U,8),1,45)_"/L:"_$E($P(^TMP($J,"GMRALAB","L",GMRAX),U,7),1,45)
|
|
.S:$P(^TMP($J,"GMRALAB","L",GMRAX),U,5)'="" GMRARSLT=$E($P(^TMP($J,"GMRALAB","L",GMRAX),U,5),1,2)_" "_GMRARSLT
|
|
.S DA=+Y,DIE=DIC,DR="1////"_GMRARSLT_";2///"
|
|
.S DR=DR_$S($P($P(^TMP($J,"GMRALAB","L",GMRAX),U)," ",2)'="":$P($P(^TMP($J,"GMRALAB","L",GMRAX),U)," ")_"@"_$P($P(^TMP($J,"GMRALAB","L",GMRAX),U)," ",2),1:$P($P(^TMP($J,"GMRALAB","L",GMRAX),U)," ")) K DIC,Y D ^DIE
|
|
.K DA,DIE,DR,GMRAX,GMRARSLT,DD,DO,%,X
|
|
.Q
|
|
Q
|
|
ADD2 ;This is to allow the patient's lab test to be added.
|
|
S DA=GMRAPA1,DIE="^GMR(120.85,",DLAYGO=120.85,DR="4" D ^DIE
|
|
S:$D(Y) GMRAOUT=1
|
|
K DA,DIE,DR
|
|
Q
|
|
DEL ;This entry point is to delete a lab entry from the Adverse Reaction file.
|
|
I '$D(^GMR(120.85,GMRAPA1,4,0)) W !,"THERE IS NO LAB DATA SELECTED FOR THIS PATIENT" Q
|
|
K DA,DO,DIC,DIE,DLAYGO,DR
|
|
S DA(1)=GMRAPA1,DIC="^GMR(120.85,"_DA(1)_",4,",DIC(0)="AMQEZ" D ^DIC
|
|
I $D(DUOUT)!($D(DTOUT)) S GMRAOUT=1 Q
|
|
I Y=-1 S GMRAOUT=1 Q
|
|
K DIC,DA,DO,DLAYGO
|
|
S DA(1)=GMRAPA1,DIK="^GMR(120.85,"_DA(1)_",4,",DA=+Y D ^DIK
|
|
K DIC,DIC,DA,DO,DLAYGO
|
|
Q
|
|
LDATE(X) ;This function takes X and will return Y
|
|
;in a format that will keep every thing lined up for prints
|
|
N Y
|
|
S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
|
|
I $P(X,".",2)'="" S X=$E($P(X,".",2),1,4) S:$L(X)<4 X=X_$E("000",1,(4-$L(X))) S Y=Y_"@"_$E(X,1,2)_":"_$E(X,3,4)
|
|
Q Y
|
|
VALST(LST,SUB) ; GIVEN LST, THIS FUNCTION RETURNS 1 IF LIST VALID, ELSE 0
|
|
N X,Y,Z,A
|
|
K GMRALST
|
|
S Z=1 F X=1:1:$L(LST,",") S Y=$P(LST,",",X) D Q:'Z
|
|
.I Y'?1N.N,Y'?1N.N1"-"1N.N S Z=0 Q
|
|
.I Y?1N.N S Y=Y_"-"_Y
|
|
.F A=$P(Y,"-"):1:$P(Y,"-",2) S:'$D(^TMP($J,"GMRALAB",SUB,A)) Z=0 Q:'Z S GMRALST(A)=""
|
|
.Q
|
|
K:'Z GMRALST
|
|
Q Z
|