Changeset 623 for WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRADSP5.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

• WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRADSP5.m (modified) (1 diff)

WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRADSP5.m

@@ -1 @@
-GMRADSP5        ;HIRMFO/YMP,RM,WAA-LISTING OF ALLERGIES TO SIGNED OFF ALLERGIES ;8/16/92
-        ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
-EN1     ; Entry to PATIENT ALLERGIES NOT SIGNED OFF option
-        S GMRAOUT=0
-        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)=""
-        S GMRANOW=$$NOW^XLFDT,GMRANOW=$$FMTE^XLFDT(GMRANOW,"2P")
-        S GMRAHEAD(1.5)=$J("Run Date/Time: "_GMRANOW,55)
-        K GMRAZIS D DEV^GMRAUTL I POP S GMRAOUT=1 G EXIT
-        I $D(IO("Q")) D TASK G EXIT
-EN2     S (GMRAORG,GMRADT)=""
-        F GMRAREC=0:0 S GMRAREC=$O(^GMR(120.8,"ASGN",GMRAREC)) Q:GMRAREC'>0  D EN2A
-        G DISP
-        Q
-EN2A    S GMRATEMP=$G(^GMR(120.8,GMRAREC,0)) Q:GMRATEMP=""
-        I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) Q:$P(GMRATEMP,U,5)'=DUZ
-        Q:'$$PRDTST^GMRAUTL1($P(GMRATEMP,U))  ;GMRA*4*33 Exclude test patient if production or legacy environment.
-        S DFN=$P(GMRATEMP,U) D PID^VADPT6 S GMRASSN=VA("BID") D KVA^VADPT
-        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_")"
-        Q
-DISP    S GMRAPG=0 D HDR^GMRADSP3 W:'$D(^TMP($J,"GMRADSP")) !!!,?7,"NO DATA FOR THIS REPORT"
-        S GMRAORG="" F  S GMRAORG=$O(^TMP($J,"GMRADSP",GMRAORG)) Q:GMRAORG=""!GMRAOUT  D  Q:GMRAOUT
-        .S GMRAIEN="" F  S GMRAIEN=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN)) Q:GMRAIEN=""!GMRAOUT  D  Q:GMRAOUT
-        ..S GMRADT="" F  S GMRADT=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT)) Q:GMRADT=""!GMRAOUT  D  Q:GMRAOUT
-        ...S GMRADFN="" F  S GMRADFN=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT,GMRADFN)) Q:GMRADFN=""!GMRAOUT  D EN3
-        ...Q
-        ..Q
-        .Q
-EXIT    ;Quit and kill
-        D CLOSE^GMRAUTL
-        K ^TMP($J,"GMRADSP"),X,Y,Z
-        D KILL^XUSCLEAN
-        Q
-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
-        .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
-        .D:IOSL-4<$Y EOP^GMRADSP3 Q:GMRAOUT
-        .Q
-        Q
-TASK    ;
-        S ZTDESC="Patient reactions not signed off",ZTRTN="EN2^GMRADSP5",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
+GMRADSP5 ;HIRMFO/YMP,RM,WAA-LISTING OF ALLERGIES TO SIGNED OFF ALLERGIES ; 8/16/92
+ ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
+EN1 ; Entry to PATIENT ALLERGIES NOT SIGNED OFF option
+ S GMRAOUT=0
+ 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)=""
+ S GMRANOW=$$NOW^XLFDT,GMRANOW=$$FMTE^XLFDT(GMRANOW,"2P")
+ S GMRAHEAD(1.5)=$J("Run Date/Time: "_GMRANOW,55)
+ K GMRAZIS D DEV^GMRAUTL I POP S GMRAOUT=1 G EXIT
+ I $D(IO("Q")) D TASK G EXIT
+EN2 S (GMRAORG,GMRADT)=""
+ F GMRAREC=0:0 S GMRAREC=$O(^GMR(120.8,"ASGN",GMRAREC)) Q:GMRAREC'>0  D EN2A
+ G DISP
+ Q
+EN2A S GMRATEMP=$G(^GMR(120.8,GMRAREC,0)) Q:GMRATEMP=""
+ I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) Q:$P(GMRATEMP,U,5)'=DUZ
+ S DFN=$P(GMRATEMP,U) D PID^VADPT6 S GMRASSN=VA("BID") D KVA^VADPT
+ 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_")"
+ Q
+DISP S GMRAPG=0 D HDR^GMRADSP3 W:'$D(^TMP($J,"GMRADSP")) !!!,?7,"NO DATA FOR THIS REPORT"
+ S GMRAORG="" F  S GMRAORG=$O(^TMP($J,"GMRADSP",GMRAORG)) Q:GMRAORG=""!GMRAOUT  D  Q:GMRAOUT
+ .S GMRAIEN="" F  S GMRAIEN=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN)) Q:GMRAIEN=""!GMRAOUT  D  Q:GMRAOUT
+ ..S GMRADT="" F  S GMRADT=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT)) Q:GMRADT=""!GMRAOUT  D  Q:GMRAOUT
+ ...S GMRADFN="" F  S GMRADFN=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT,GMRADFN)) Q:GMRADFN=""!GMRAOUT  D EN3
+ ...Q
+ ..Q
+ .Q
+EXIT ;Quit and kill
+ D CLOSE^GMRAUTL
+ K ^TMP($J,"GMRADSP"),X,Y,Z
+ D KILL^XUSCLEAN
+ Q
+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
+ .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
+ .D:IOSL-4<$Y EOP^GMRADSP3 Q:GMRAOUT
+ .Q
+ Q
+TASK ;
+ S ZTDESC="Patient reactions not signed off",ZTRTN="EN2^GMRADSP5",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