source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPHR2.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1GMRAPHR2 ;HIRMFO/WAA,FT-ADD/DELETE/EDIT SUSPECT DRUGS ;9/11/96 10:49
2 ;;4.0;Adverse Reaction Tracking;**5**;Mar 29, 1996
3EN1 ;
4 Q:GMRAOUT
5 W @IOF N DIE,DA,GMRAXXX,GMRAX,GMRAGHC
6 K ^UTILITY("PSG",$J),^UTILITY("PSIV",$J),GMRARRAY
7 S GMRADT=$P(^GMR(120.85,GMRAPA1,0),U)
8 D ^GMRADSP7 G:'GMRAPA EXIT
9SELECT W ! D LST
10 ;SELECT ACTION
11 K DIR S DIR(0)="SOBA^A:ADD;D:DELETE;E:EDIT",DIR("A")="Select Action (A/D/E): "
12 S DIR("?")="ENTER A TO ADD A NEW DRUG, D TO DELETE A DRUG OR E TO EDIT"
13 D ^DIR K DIR I "^^"[Y S GMRAOUT=$L(Y) G EXIT
14 S GMRASEL=Y
15 I GMRASEL="A" S GMRALOOK=0 W ! D ADD K GMRALOOK G:GMRAOUT EXIT K GMRALOOK G SELECT
16 I GMRASEL="D" W ! D DEL G:GMRAOUT EXIT G SELECT
17 I GMRASEL="E" W ! D EDIT G:GMRAOUT EXIT G SELECT
18 G SELECT
19EDIT ;EDIT A DRUG
20 I '$O(^GMR(120.85,GMRAPA1,3,0)) W !,?3,"YOU CANNOT EDIT WHEN THERE IS NO DATA ON FILE.",$C(7) Q
21EDITLST ; DISPLAY TO EDIT FIELD
22 W !,"Select the DRUG RX you want to edit:",!
23 D LST
24EEDT K DA,DO,DIC,DIE,DLAYGO,DR
25 S DA(1)=GMRAPA1,DIC="^GMR(120.85,"_DA(1)_",3,",DIC(0)="AMQEZ" D ^DIC K DIC
26 I $D(DUOUT)!($D(DTOUT))!(Y=-1) S GMRAOUT=1 G QE
27 S GMRASUS=+Y
28 S DA(1)=GMRAPA1,DIE="^GMR(120.85,"_DA(1)_",3,",DA=+Y,DR=".01;1;1.5;2;3;4;S X=X;5;S X=X;6;7;8;9;10;10.1;10.2" D ^DIE
29 I $D(DUOUT)!($D(DTOUT))!('$D(DA))!($D(Y)) G QE
30 K GMRAX,DA,DIE,DR,DIC,DLAYGO D EN1^GMRAPEL0
31QE K GMRAX,DA,DIE,DR,DIC,DLAYGO,GMRASUS
32 Q
33ADD ;SELECTION OF A DRUG OR ENTER A NEW DRUG
34 D DISP^GMRAPHR0 I GMRAOUT S GMRAOUT=GMRAOUT-1 Q:GMRAOUT
35 K % I '$D(GMRARRAY) D ADD2 S GMRAOUT=GMRAOUT-1 Q:GMRAOUT!(X="")!($D(Y)) G ADD
36ADDED W !,"Enter the number(s) of the RX/DRUG to ADD or ""N"" for NEW: "
37 R GMRAX:DTIME S:'$T GMRAX="^^" I "^^"[GMRAX S GMRAOUT=$L(GMRAX) Q
38 I "??"[GMRAX W !,"ENTER THE NUMBER(S) OF THE ENTRY YOU WANT OR ""N"" FOR A NEW DRUG" G:$L(GMRAX)=1 ADDED G ADD
39 I GMRAX="n" S GMRAX="N"
40 I GMRAX="N" D ADD2 Q:X="" G ADD
41 I '$$VALST(GMRAX,"PH") W !,$C(7),"INVALID SELECTION PLEASE SELECT ONE OF THE DRUGS LISTED OR ""N"" FOR A NEW DRUG" G ADD
42 S GMRALST=0 F S GMRALST=$O(GMRALST(GMRALST)) Q:GMRALST<1 S GMRAX=GMRALST D Q:GMRAOUT
43 .S X=$P(GMRARRAY("PH",GMRAX),U,2)
44 .I $D(^GMR(120.85,GMRAPA1,3,"B",X)) D Q:GMRAOUT!(%-1) K %
45 ..W !,"You already have a ",X," DRUG on file."
46 ..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 DRUG or NO TO SELECT ANOTHER"
47 ..Q
48 .K DD,DO
49 .I '$O(^GMR(120.85,GMRAPA1,3,0)) S ^(0)="^120.8503^^"
50 .S DA(1)=GMRAPA1,DIC="^GMR(120.85,"_GMRAPA1_",3,",DIC(0)="L",DLAYGO=120.85 D FILE^DICN
51 .I $G(DTOUT,0)!($G(DUOUT)) K DIC,DTOUT,DUOUT S GMRAOUT=1 Q
52 .Q:(+Y<1)
53 .S DA=+Y,DIE=DIC K DIC
54 .I $P(GMRARRAY("PH",GMRAX),U)="OP" S DR="1.5////"_$E($P(GMRARRAY("PH",GMRAX),U,3),1,30)_";10////"_$P(GMRARRAY("PH",GMRAX),U,4)
55 .I $P(GMRARRAY("PH",GMRAX),U)="D" D
56 ..S DR="1////"_$P(GMRARRAY("PH",GMRAX),U,3)_";2////"_$P(GMRARRAY("PH",GMRAX),U,4)
57 ..S DR=DR_";4////"_$P(GMRARRAY("PH",GMRAX),U,6)_";5////"_$P(GMRARRAY("PH",GMRAX),U,7)
58 ..Q
59 .I $P(GMRARRAY("PH",GMRAX),U)="IV" D
60 ..S DR="1////"_$P(GMRARRAY("PH",GMRAX),U,3)_";2////IV"
61 ..S DR=DR_";4////"_$P(GMRARRAY("PH",GMRAX),U,6)_";5////"_$P(GMRARRAY("PH",GMRAX),U,7)
62 ..Q
63 .S GMRASUS=DA D ^DIE K DIE,DA,DR,GMRAX
64 .I '$D(DUOUT)!($D(DTOUT)) N X D EN1^GMRAPEL0
65 .K GMRASUS Q
66 Q
67ADD2 ;
68 K DD,DO
69 I '$O(^GMR(120.85,GMRAPA1,3,0)) S ^(0)="^120.8503^^"
70 S $P(^GMR(120.85,GMRAPA1,3,0),"^",2)="120.8503O"
71 S DA(1)=GMRAPA1,DIC="^GMR(120.85,"_GMRAPA1_",3,",DIC(0)="AEMLQZ",DLAYGO=120.85 D ^DIC
72 S $P(^GMR(120.85,GMRAPA1,3,0),"^",2)="120.8503"
73 I $D(DUOUT)!$D(DTOUT) S GMRAOUT=1 I $D(DTOUT) S GMRAOUT=GMRAOUT+1
74 I GMRAOUT!(+Y<1) K DIC,DA Q
75 S DA=+Y K DIC
76 S DA(1)=GMRAPA1,DIE="^GMR(120.85,"_GMRAPA1_",3,",DLAYGO=120.85,DR="1:10.2" D ^DIE
77 I '$D(Y)!$G(DTOUT) S GMRAOUT=1 I $G(DTOUT) S GMRAOUT=GMRAOUT+1
78 S X=$P($G(^GMR(120.85,GMRAPA1,3,DA,0)),U,1)
79 I 'GMRAOUT N X S GMRASUS=DA D EN1^GMRAPEL0
80 K DA,DIE,DLAYGO,DR,GMRASUS
81 Q
82DEL ;
83 I '$D(^GMR(120.85,GMRAPA1,3,0)) W !,"THERE ARE NO DRUG SELECTED FOR THIS PATIENT" Q
84 K DA,DO,DIC,DIE,DLAYGO,DR
85 S DA(1)=GMRAPA1,DIC="^GMR(120.85,"_DA(1)_",3,",DIC(0)="AMQEZ" D ^DIC
86 I $D(DUOUT)!($D(DTOUT))!(Y=-1) S GMRAOUT=1 G DQ
87 K DIC,DA,DO
88 S DA(1)=GMRAPA1,DIK="^GMR(120.85,"_DA(1)_",3,",DA=+Y D ^DIK
89DQ K DIC,DIC,DA,DO,DLAYGO,DIK,Y
90 Q
91LST I '$O(^GMR(120.85,GMRAPA1,3,0)) W !,"THIS PATIENT HAS NO SUSPECTED AGENTS ON FILE" Q
92 W !,"This patient has the following Drugs selected: ",!
93 S GMRAX=0 F GMRAXX=1:1 S GMRAX=$O(^GMR(120.85,GMRAPA1,3,GMRAX)) Q:GMRAX<1 W !,?10,$P(^(GMRAX,0),U)
94 Q
95EXIT ;EXIT LINE
96 K DIR,Y,GMRASEL,GMRABGDT,GMRAENDT,^UTILITY("PSG",$J),^UTILITY("PSIV",$J),GMRARRAY
97 Q
98VALST(LST,SUB) ; GIVEN LST, THIS FUNCTION RETURNS 1 IF LIST VALID, ELSE 0
99 N X,Y,Z,A
100 K GMRALST
101 S Z=1 F X=1:1:$L(LST,",") S Y=$P(LST,",",X) D Q:'Z
102 .I Y'?1N.N,Y'?1N.N1"-"1N.N S Z=0 Q
103 .I Y?1N.N S Y=Y_"-"_Y
104 .F A=$P(Y,"-"):1:$P(Y,"-",2) S:'$D(GMRARRAY(SUB,A)) Z=0 Q:'Z S GMRALST(A)=""
105 .Q
106 K:'Z GMRALST
107 Q Z
Note: See TracBrowser for help on using the repository browser.