source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAU851.m@ 1046

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

initial load of WorldVistAEHR
File size: 3.6 KB
RevLine 
[613]1GMRAU851 ;HIRMFO/RFM,WAA-UTILITIES FOR FILE 120.85 ;12/22/04 11:02
2 ;;4.0;Adverse Reaction Tracking;**21**;Mar 29, 1996
3HLP ;
4 N DIR
5 I '$D(^GMR(120.8,"B",DFN)) W !?4,"There are no reactions on file for this patient." Q
6 D HLP12085(DFN,"$$OBSDRG^GMRAU85(GMRAX)")
7 Q
8HLP12085(DFN,SCR) ; THIS WILL LIST ENTRIES FOR PATIENT (DFN) IN FILE
9 ; 120.85. AN OPTIONAL SCREEN (SCR), EXECUTABLE BOOLEAN FXN, WILL BE
10 ; USED TO SCREEN OUT ENTRIES, WHILE USING SCREEN, GMRAX WILL BE 120.8
11 ; IEN. GMRAOUT WILL BE SET TRUE IF ^/TIME OUT.
12 N GMRAL,GMRAX,GMRAY
13 I $G(SCR)="" S SCR="SCR=SCR"
14 S GMRAX="" F S GMRAX=$O(^GMR(120.8,"B",DFN,GMRAX)) Q:GMRAX'>0 S GMRAY=$P($G(^GMR(120.8,GMRAX,0)),U,2) I GMRAY]"",@SCR S GMRAL(GMRAY,GMRAX)=""
15 W #,!!,"CHOOSE FROM:" S GMRAY="" F Q:GMRAOUT S GMRAY=$O(GMRAL(GMRAY)) Q:GMRAY="" S GMRAX="" F S GMRAX=$O(GMRAL(GMRAY,GMRAX)) Q:GMRAX'>0 D Q:GMRAOUT
16 . I $Y>(IOSL-3) D ENDPG^GMRADSP3 Q:GMRAOUT W #
17 . W !?3,GMRAY
18 . Q
19 Q
20HLP1 ;
21 I '$D(^GMR(120.85,"C",GMRAPA)) W !?4,"There are no observed date/times on file for this reaction." Q
22 S X="??",DIC="^GMR(120.85,",DIC(0)="EQ",DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,15)=GMRAPA",DIC("W")="" D ^DIC K DIC
23 Q
24RXN ;ENTRY TO EDIT THE OBSERVED A/AR DATA
25 N GMRAR0 ;21
26 S GMRANDT=1
27 S GMRAPA=$P($G(^GMR(120.85,GMRAPA1,0)),U,15),GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
28 S GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
29 F GMRAX=0:0 S GMRAX=$O(^GMR(120.85,GMRAPA1,2,GMRAX)) Q:GMRAX'>0 S Y=$S($D(^GMR(120.85,GMRAPA1,2,GMRAX,0)):^(0),1:""),X=$S(+Y=GMRAOTH:$P(Y,"^",2),$D(^GMRD(120.83,+Y,0)):$P(^(0),"^"),1:"") I X'="",Y'="" S GMRARPR(X,+Y)=X_"^"_$P(Y,"^",3)
30 D SITE^GMRAUTL
31 S GMRAY=GMRASITE
32 I GMRAY>0 F GMRAX=1:1:10 S X=$S($D(^GMRD(120.84,GMRAY,1,GMRAX,0)):$P(^(0),"^"),1:""),Y=$S($D(^GMRD(120.83,+X,0)):^(0),1:""),GMRAR10(GMRAX)=$S(X'=""!(Y'=""):X_"^"_Y,1:"")
33 D EN1^GMRAPER0 Q:GMRAOUT S:'$D(^GMR(120.85,GMRAPA1,2,0)) ^(0)="^120.8502P^^" S:'$D(^GMR(120.8,GMRAPA,10,0)) ^(0)="^120.81P^^" ;21
34 F GMRAREC=0:0 S GMRAREC=$O(GMRARAD(GMRAREC)) Q:GMRAREC'>0 S GMRAR0=GMRAREC_"^^"_DUZ D ADREAC ;21
35 S GMRAREC="" F GMRAX=0:0 S GMRAREC=$O(GMRAROT(GMRAREC)) Q:GMRAREC="" S GMRAR0=GMRAOTH_"^"_GMRAREC_"^"_DUZ D ADREAC ;21
36 F GMRAREC=0:0 S GMRAREC=$O(GMRARDL(GMRAREC)) Q:GMRAREC'>0 D DELREAC ;21
37 S GMRAREC="" F GMRAX=0:0 S GMRAREC=$O(GMRAROTD(GMRAREC)) Q:GMRAREC="" D DELREACO ;21
38 Q
39ADREAC ; ADD ENTRY TO SIGNS/SYMPTOMS MULTIPLE
40 S GMRAZN=$P(^GMR(120.85,GMRAPA1,2,0),"^",3,4),DA=$P(GMRAZN,"^")+1 F DA=DA:1 Q:'$D(^GMR(120.85,GMRAPA1,2,DA,0))
41 S ^GMR(120.85,GMRAPA1,2,DA,0)=GMRAR0 S DIK="^GMR(120.85,DA(1),2,",DA(1)=GMRAPA1 D IX1^DIK S $P(^GMR(120.85,GMRAPA1,2,0),"^",3,4)=DA_"^"_($P(GMRAZN,"^",2)+1)
42 S GMRAZN=$P(^GMR(120.8,GMRAPA,10,0),"^",3,4),DA=$P(GMRAZN,"^")+1 F DA=DA:1 Q:'$D(^GMR(120.8,GMRAPA,10,DA,0)) ;21
43 S ^GMR(120.8,GMRAPA,10,DA,0)=GMRAR0_"^"_DT S DIK="^GMR(120.8,DA(1),10,",DA(1)=GMRAPA D IX1^DIK S $P(^GMR(120.8,GMRAPA,10,0),"^",3,4)=DA_"^"_($P(GMRAZN,"^",2)+1) ;21
44 Q
45 ;
46DELREAC ;Delete reactions from 120.85 and 120.8 entire section added in patch 21
47 S DA(1)=GMRAPA1,DIK="^GMR(120.85,"_DA(1)_",2,"
48 F DA=0:0 S DA=$O(^GMR(120.85,DA(1),2,"B",GMRAREC,DA)) Q:DA'>0 D ^DIK
49 S DA(1)=GMRAPA,DIK="^GMR(120.8,"_DA(1)_",10,"
50 F DA=0:0 S DA=$O(^GMR(120.8,DA(1),10,"B",GMRAREC,DA)) Q:DA'>0 D ^DIK
51 Q
52 ;
53DELREACO ;Delete free text reactions, added in 21
54 S DA(1)=GMRAPA1,DIK="^GMR(120.85,"_DA(1)_",2,"
55 F DA=0:0 S DA=$O(^GMR(120.85,DA(1),2,"B",GMRAOTH,DA)) Q:DA'>0 I $D(^GMR(120.85,DA(1),2,DA,0)),$P(^(0),U,2)=GMRAREC D ^DIK
56 S DA(1)=GMRAPA,DIK="^GMR(120.8,"_DA(1)_",10,"
57 F DA=0:0 S DA=$O(^GMR(120.8,DA(1),10,"B",GMRAOTH,DA)) Q:DA'>0 I $D(^GMR(120.8,DA(1),10,DA,0)),$P(^(0),U,2)=GMRAREC D ^DIK
58 Q
Note: See TracBrowser for help on using the repository browser.