| 1 | GMRADSP5 ;HIRMFO/YMP,RM,WAA-LISTING OF ALLERGIES TO SIGNED OFF ALLERGIES ;8/16/92
|
|---|
| 2 | ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
|
|---|
| 3 | EN1 ; Entry to PATIENT ALLERGIES NOT SIGNED OFF option
|
|---|
| 4 | S GMRAOUT=0
|
|---|
| 5 | S GMRAHEAD(1)=$J("ALLERGY/ADVERSE REACTIONS TO BE SIGNED OFF",59),GMRAHEAD(4)=$J("ORIGINATOR",10)_$J("PATIENT",21)_$J("ALLERGY",19)_$J("ORIGINATION DATE/TIME",29),(GMRAHEAD(3),GMRAHEAD(5),GMRAHEAD(6))="",$P(GMRAHEAD(5),"-",81)=""
|
|---|
| 6 | S GMRANOW=$$NOW^XLFDT,GMRANOW=$$FMTE^XLFDT(GMRANOW,"2P")
|
|---|
| 7 | S GMRAHEAD(1.5)=$J("Run Date/Time: "_GMRANOW,55)
|
|---|
| 8 | K GMRAZIS D DEV^GMRAUTL I POP S GMRAOUT=1 G EXIT
|
|---|
| 9 | I $D(IO("Q")) D TASK G EXIT
|
|---|
| 10 | EN2 S (GMRAORG,GMRADT)=""
|
|---|
| 11 | F GMRAREC=0:0 S GMRAREC=$O(^GMR(120.8,"ASGN",GMRAREC)) Q:GMRAREC'>0 D EN2A
|
|---|
| 12 | G DISP
|
|---|
| 13 | Q
|
|---|
| 14 | EN2A S GMRATEMP=$G(^GMR(120.8,GMRAREC,0)) Q:GMRATEMP=""
|
|---|
| 15 | I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) Q:$P(GMRATEMP,U,5)'=DUZ
|
|---|
| 16 | Q:'$$PRDTST^GMRAUTL1($P(GMRATEMP,U)) ;GMRA*4*33 Exclude test patient if production or legacy environment.
|
|---|
| 17 | S DFN=$P(GMRATEMP,U) D PID^VADPT6 S GMRASSN=VA("BID") D KVA^VADPT
|
|---|
| 18 | I $P(GMRATEMP,U,5)'="" S ^TMP($J,"GMRADSP",$P(^VA(200,$P(GMRATEMP,U,5),0),U),$P(GMRATEMP,U,5),$P(GMRATEMP,U,4),$P(GMRATEMP,U),GMRAREC)=$P(GMRATEMP,U,2)_U_$E($P(^DPT($P(GMRATEMP,U),0),U),1,14)_"("_GMRASSN_")"
|
|---|
| 19 | Q
|
|---|
| 20 | DISP S GMRAPG=0 D HDR^GMRADSP3 W:'$D(^TMP($J,"GMRADSP")) !!!,?7,"NO DATA FOR THIS REPORT"
|
|---|
| 21 | S GMRAORG="" F S GMRAORG=$O(^TMP($J,"GMRADSP",GMRAORG)) Q:GMRAORG=""!GMRAOUT D Q:GMRAOUT
|
|---|
| 22 | .S GMRAIEN="" F S GMRAIEN=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN)) Q:GMRAIEN=""!GMRAOUT D Q:GMRAOUT
|
|---|
| 23 | ..S GMRADT="" F S GMRADT=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT)) Q:GMRADT=""!GMRAOUT D Q:GMRAOUT
|
|---|
| 24 | ...S GMRADFN="" F S GMRADFN=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT,GMRADFN)) Q:GMRADFN=""!GMRAOUT D EN3
|
|---|
| 25 | ...Q
|
|---|
| 26 | ..Q
|
|---|
| 27 | .Q
|
|---|
| 28 | EXIT ;Quit and kill
|
|---|
| 29 | D CLOSE^GMRAUTL
|
|---|
| 30 | K ^TMP($J,"GMRADSP"),X,Y,Z
|
|---|
| 31 | D KILL^XUSCLEAN
|
|---|
| 32 | Q
|
|---|
| 33 | EN3 S GMRAPAT="" F S GMRAPAT=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT,GMRADFN,GMRAPAT)) Q:GMRAPAT=""!GMRAOUT S GMRALL=$G(^(GMRAPAT)) I GMRALL'="" D Q:GMRAOUT
|
|---|
| 34 | .S Y=GMRADT D D^DIQ W !,$E(GMRAORG,1,15),?17,$P(GMRALL,U,2),?42,$E($P(GMRALL,U),1,16),?59,Y
|
|---|
| 35 | .D:IOSL-4<$Y EOP^GMRADSP3 Q:GMRAOUT
|
|---|
| 36 | .Q
|
|---|
| 37 | Q
|
|---|
| 38 | TASK ;
|
|---|
| 39 | S ZTDESC="Patient reactions not signed off",ZTRTN="EN2^GMRADSP5",ZTDTH="",ZTIO=ION,ZTSAVE("GMRA*")="",ZTSAVE("DFN")="" D ^%ZTLOAD
|
|---|
| 40 | W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
|
|---|
| 41 | K ZTRTN,ZTDH,ZTSAVE,ZTDTH,ZTSK
|
|---|
| 42 | Q
|
|---|
