source: FOIAVistA/tag/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRADSP6.m@ 628

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