67 lines
3.3 KiB
Mathematica
67 lines
3.3 KiB
Mathematica
GMRADSP6 ;HIRMFO/YMP,RM,WAA-LISTING OF ALLERGIES NOT ENTERED IN ERROR ;9/23/97 09:07
|
|
;;4.0;Adverse Reaction Tracking;**8**;Mar 29, 1996
|
|
EN1 ; Entry to ACTIVE LISTING OF PATIENT REACTIONS option
|
|
S GMRAOUT=0
|
|
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
|
|
EN3 ;Print Active Patient list if patient is known
|
|
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
|
|
S GMRAHEAD(1)=$J("ACTIVE ALLERGY/ADVERSE REACTION LISTING",58),(GMRAHEAD(3),GMRAHEAD(6),GMRAHEAD(7))="",$P(GMRAHEAD(6),"-",81)=""
|
|
S GMRAHEAD(4)=$J("OBS/",73),GMRAHEAD(5)=$J("ADVERSE REACTION",17)_$J("VERIFIED",48)_$J("HIST",8)
|
|
S GMRANOW=$$NOW^XLFDT,GMRANOW=$$FMTE^XLFDT(GMRANOW,"2P")
|
|
S GMRAHEAD(1.5)=$J("Run Date/Time: "_GMRANOW,55)
|
|
I '$D(^GMR(120.86,"B",DFN)) W !!,$C(7),"NO ALLERGY/ADVERSE REACTION DATA EXISTS FOR THIS PATIENT" G EN1
|
|
K GMRAZIS D DEV^GMRAUTL I POP S GMRAOUT=1 G EXIT
|
|
I $D(IO("Q")) D TASK G EXIT
|
|
EN2 ; Print Active Patient list if patient and device known
|
|
S (GMRAOUT,GMRAPG)=0 D HDR^GMRADSP3
|
|
S GMRALIN=$$REPEAT^XLFSTR("=",32)
|
|
I $P($G(^GMR(120.86,DFN,0)),U,2)'=1 W !," Patient has answered NKA."
|
|
E F GMRAREC=0:0 S GMRAREC=$O(^GMR(120.8,"B",DFN,GMRAREC)) Q:GMRAREC'>0 D EN2A
|
|
S GMRAREAC=0 G DISP
|
|
Q
|
|
EN2A Q:+$G(^GMR(120.8,GMRAREC,"ER")) S GMRATEMP=$G(^GMR(120.8,GMRAREC,0)) Q:'$P(GMRATEMP,"^",12)
|
|
S GMRAKIND=$P(GMRATEMP,"^",20)
|
|
S ^TMP($J,"GMRADSP",GMRAKIND,$P(GMRATEMP,"^",2),GMRAREC)=""
|
|
Q
|
|
DISP ;
|
|
S GMRASPAC=53,GMRATONS=""
|
|
S (GMRAALL,GMRAKIND,GMRARECN)=""
|
|
I '$D(^TMP($J,"GMRADSP")) W !,?33,"No Data Found"
|
|
F X=0:0 S GMRAKIND=$O(^TMP($J,"GMRADSP",GMRAKIND)) Q:GMRAKIND=""!GMRAOUT D DISP2
|
|
G EXIT
|
|
DISP2 D:$Y>(IOSL-4) EOP^GMRADSP3 Q:GMRAOUT
|
|
S GMRATYPE=$$OUTTYPE^GMRAUTL(GMRAKIND)
|
|
W !!?3,"TYPE: ",GMRATYPE,!?3,$E(GMRALIN,1,$L(GMRATYPE)+6)
|
|
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
|
|
Q
|
|
REST ;
|
|
D:$Y>(IOSL-4) EOP^GMRADSP3 Q:GMRAOUT
|
|
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:"")
|
|
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
|
|
.N GMRALINE,GMRATON,GMRAZ,GMRAFG2
|
|
.S GMRATON=$G(^GMR(120.8,GMRARECN,10,GMRAX,0))
|
|
.S GMRAFG=$O(^GMR(120.8,GMRARECN,10,GMRAX))
|
|
.I +GMRATON'=GMRAOTH S GMRALINE=$E($S($D(^GMRD(120.83,+GMRATON,0)):$P(^(0),U),1:""),1,23)
|
|
.E S GMRALINE=$P(GMRATON,U,2)
|
|
.S GMRAZ=$S($P(GMRATON,U,4)'="":$$FMTE^XLFDT($P(GMRATON,U,4),1),1:"")
|
|
.S:GMRAZ'="" GMRALINE=GMRALINE_" ("_GMRAZ_")"
|
|
.I GMRAFG S GMRALINE=GMRALINE_", "
|
|
.D WRITG
|
|
.Q
|
|
Q
|
|
WRITG ;
|
|
I 'GMRAFLG W !,?5,"Reactions: " S GMRAFLG=1
|
|
I $X+$L(GMRALINE)>GMRASPAC W !,?16
|
|
W GMRALINE
|
|
Q
|
|
EXIT ;Quit and kill
|
|
D CLOSE^GMRAUTL
|
|
K ^TMP($J,"GMRADSP"),X,Y,Z
|
|
D KILL^XUSCLEAN
|
|
Q
|
|
TASK ;
|
|
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
|
|
W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
|
|
K ZTRTN,ZTDH,ZTSAVE,ZTDTH,ZTSK
|
|
Q
|