source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRADSP6.m@ 1378

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

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1GMRADSP6 ;HIRMFO/YMP,RM,WAA-LISTING OF ALLERGIES NOT ENTERED IN ERROR ;9/23/97 09:07
2 ;;4.0;Adverse Reaction Tracking;**8**;Mar 29, 1996
3EN1 ; Entry to ACTIVE LISTING OF PATIENT REACTIONS option
4 S GMRAOUT=0
5 W ! S DIC="^DPT(",DIC(0)="AEQM",DIC("A")="Select PATIENT: " D ^DIC K DIC,DLAYGO S DFN=+Y I +Y'>0 S GMRAOUT=1 G EXIT
6EN3 ;Print Active Patient list if patient is known
7 D DEM^VADPT S GMRAHEAD(2)=$J($E(VADM(1),1,15),1)_$J(VA("PID"),21)_$J($P(VADM(3),"^",2),24)_$J($S(VADM(4):"("_VADM(4)_")",1:""),5) D KVAR^VADPT K VA
8 S GMRAHEAD(1)=$J("ACTIVE ALLERGY/ADVERSE REACTION LISTING",58),(GMRAHEAD(3),GMRAHEAD(6),GMRAHEAD(7))="",$P(GMRAHEAD(6),"-",81)=""
9 S GMRAHEAD(4)=$J("OBS/",73),GMRAHEAD(5)=$J("ADVERSE REACTION",17)_$J("VERIFIED",48)_$J("HIST",8)
10 S GMRANOW=$$NOW^XLFDT,GMRANOW=$$FMTE^XLFDT(GMRANOW,"2P")
11 S GMRAHEAD(1.5)=$J("Run Date/Time: "_GMRANOW,55)
12 I '$D(^GMR(120.86,"B",DFN)) W !!,$C(7),"NO ALLERGY/ADVERSE REACTION DATA EXISTS FOR THIS PATIENT" G EN1
13 K GMRAZIS D DEV^GMRAUTL I POP S GMRAOUT=1 G EXIT
14 I $D(IO("Q")) D TASK G EXIT
15EN2 ; Print Active Patient list if patient and device known
16 S (GMRAOUT,GMRAPG)=0 D HDR^GMRADSP3
17 S GMRALIN=$$REPEAT^XLFSTR("=",32)
18 I $P($G(^GMR(120.86,DFN,0)),U,2)'=1 W !," Patient has answered NKA."
19 E F GMRAREC=0:0 S GMRAREC=$O(^GMR(120.8,"B",DFN,GMRAREC)) Q:GMRAREC'>0 D EN2A
20 S GMRAREAC=0 G DISP
21 Q
22EN2A Q:+$G(^GMR(120.8,GMRAREC,"ER")) S GMRATEMP=$G(^GMR(120.8,GMRAREC,0)) Q:'$P(GMRATEMP,"^",12)
23 S GMRAKIND=$P(GMRATEMP,"^",20)
24 S ^TMP($J,"GMRADSP",GMRAKIND,$P(GMRATEMP,"^",2),GMRAREC)=""
25 Q
26DISP ;
27 S GMRASPAC=53,GMRATONS=""
28 S (GMRAALL,GMRAKIND,GMRARECN)=""
29 I '$D(^TMP($J,"GMRADSP")) W !,?33,"No Data Found"
30 F X=0:0 S GMRAKIND=$O(^TMP($J,"GMRADSP",GMRAKIND)) Q:GMRAKIND=""!GMRAOUT D DISP2
31 G EXIT
32DISP2 D:$Y>(IOSL-4) EOP^GMRADSP3 Q:GMRAOUT
33 S GMRATYPE=$$OUTTYPE^GMRAUTL(GMRAKIND)
34 W !!?3,"TYPE: ",GMRATYPE,!?3,$E(GMRALIN,1,$L(GMRATYPE)+6)
35 F X=0:0 S GMRAALL=$O(^TMP($J,"GMRADSP",GMRAKIND,GMRAALL)) Q:GMRAALL=""!(GMRAOUT) F GMRARECN=0:0 S GMRARECN=$O(^TMP($J,"GMRADSP",GMRAKIND,GMRAALL,GMRARECN)) Q:GMRARECN'>0 D REST Q:GMRAOUT
36 Q
37REST ;
38 D:$Y>(IOSL-4) EOP^GMRADSP3 Q:GMRAOUT
39 S GMRATEMP=$G(^GMR(120.8,GMRARECN,0)) W !,GMRAALL,?60,$P("NO^YES","^",1+$P(GMRATEMP,U,16)),?70,$S($P(GMRATEMP,U,6)="h":"HIST",$P(GMRATEMP,U,6)="o":"OBS",1:"")
40 I $D(^GMR(120.8,GMRARECN,10,0)) S GMRAFLG=0,GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0)) F GMRAX=0:0 S GMRAX=$O(^GMR(120.8,GMRARECN,10,GMRAX)) Q:GMRAX'>0 D
41 .N GMRALINE,GMRATON,GMRAZ,GMRAFG2
42 .S GMRATON=$G(^GMR(120.8,GMRARECN,10,GMRAX,0))
43 .S GMRAFG=$O(^GMR(120.8,GMRARECN,10,GMRAX))
44 .I +GMRATON'=GMRAOTH S GMRALINE=$E($S($D(^GMRD(120.83,+GMRATON,0)):$P(^(0),U),1:""),1,23)
45 .E S GMRALINE=$P(GMRATON,U,2)
46 .S GMRAZ=$S($P(GMRATON,U,4)'="":$$FMTE^XLFDT($P(GMRATON,U,4),1),1:"")
47 .S:GMRAZ'="" GMRALINE=GMRALINE_" ("_GMRAZ_")"
48 .I GMRAFG S GMRALINE=GMRALINE_", "
49 .D WRITG
50 .Q
51 Q
52WRITG ;
53 I 'GMRAFLG W !,?5,"Reactions: " S GMRAFLG=1
54 I $X+$L(GMRALINE)>GMRASPAC W !,?16
55 W GMRALINE
56 Q
57EXIT ;Quit and kill
58 D CLOSE^GMRAUTL
59 K ^TMP($J,"GMRADSP"),X,Y,Z
60 D KILL^XUSCLEAN
61 Q
62TASK ;
63 S ZTDESC="This a print out of the allergies signed off for the patient",ZTRTN="EN2^GMRADSP6",ZTDTH="",ZTIO=ION,ZTSAVE("GMRA*")="",ZTSAVE("DFN")="" D ^%ZTLOAD
64 W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
65 K ZTRTN,ZTDH,ZTSAVE,ZTDTH,ZTSK
66 Q
Note: See TracBrowser for help on using the repository browser.