Changeset 623 for WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQOR.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQOR.m
r613 r623 1 XQOR 2 ;;8.0;KERNEL;**48,56,437**;Jul 10, 1995;Build 23 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 EN 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 EX 47 48 49 EN1 50 51 52 53 XQ 54 55 56 MSG(X,XQORMSG) 57 58 59 60 61 62 63 64 65 1 XQOR ; SLC/KCM - Prepare to Unwind Options ;4/3/07 16:21 2 ;;8.0;KERNEL;**48,56,437**;Jul 10, 1995;Build 22 3 ; Modified from FOIA VISTA, 4 ; Copyright (C) 2007 WorldVistA 5 ; 6 ; This program is free software; you can redistribute it and/or modify 7 ; it under the terms of the GNU General Public License as published by 8 ; the Free Software Foundation; either version 2 of the License, or 9 ; (at your option) any later version. 10 ; 11 ; This program is distributed in the hope that it will be useful, 12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 ; GNU General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU General Public License 17 ; along with this program; if not, write to the Free Software 18 ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 19 S DIC=19,DIC(0)="AEMQ" D ^DIC K DIC Q:Y<0 S X=+Y_";DIC(19," 20 EN ;Process options/protocols from top 21 ;From: Anywhere Entry: X,{DIC,XQORFLG} Exit: none 22 Q:$D(X)[0 K XQORPOP,XQORQUIT 23 I '$D(XQORS) S XQORS=0 K ^TMP("XQORS",$J) 24 S XQORS=XQORS+1 ;push 25 I $D(XQOR("HIJACK")) S X=XQOR("HIJACK"),DIC=101 K XQOR("HIJACK") 26 I X?1.N1";ORD(101,"!(X?1.N1";DIC(19,") S ^TMP("XQORS",$J,XQORS,"REF")="^"_$P(X,";",2)_+X_",",^TMP("XQORS",$J,XQORS,"VPT")=X 27 E S:$D(DIC)[0 DIC=19 S DIC(0)="N" D ^DIC S:Y>0 ^TMP("XQORS",$J,XQORS,"REF")=DIC_+Y_",",^TMP("XQORS",$J,XQORS,"VPT")=+Y_";"_$P(DIC,"^",2) K DIC G:Y<0 EX 28 S XQORNEST(XQORS)=^TMP("XQORS",$J,XQORS,"VPT"),XQORNEST=XQORS 29 G:'$D(@(^TMP("XQORS",$J,XQORS,"REF")_"0)")) EX S ^TMP("XQORS",$J,XQORS,"FLG")=$P(^(0),"^",4)_"^^" G:$P(^TMP("XQORS",$J,XQORS,"FLG"),"^")'?1A EX 30 ; LOCAL MOD VWSD SILENTMODE ECHO SDAM EVENTS (VARIABLE XQORMUTE) 31 I $L($P(@(^TMP("XQORS",$J,XQORS,"REF")_"0)"),"^",3)) W:'$D(ZTSK)&'$D(XQORMUTE) !!,$P(^(0),"^",3),! D:'$D(ZTSK)&'$D(XQORMUTE) READ^XQOR4 G EX 32 ;I $L($P(@(^TMP("XQORS",$J,XQORS,"REF")_"0)"),"^",3)) W !!,$P(^(0),"^",3),! D READ^XQOR4 G EX 33 ;END LOCAL MODE 34 D C19^XQOR4 G:Y<0 EX 35 S ^TMP("XQORS",$J,0,"FILE")=";"_$P(^TMP("XQORS",$J,XQORS,"VPT"),";",2),^TMP("XQORS",$J,XQORS,"INP")="" 36 I XQORS>1,$D(^TMP("XQORS",$J,XQORS-1,"ITM")),$D(^TMP("XQORS",$J,XQORS-1,"ITM",^TMP("XQORS",$J,XQORS-1,"ITM"),"IN")) S ^TMP("XQORS",$J,XQORS,"INP")=^TMP("XQORS",$J,XQORS-1,"ITM",^TMP("XQORS",$J,XQORS-1,"ITM"),"IN") 37 I XQORS>1,$D(XQORFLG("PI")) K XQORFLG("PI") S ^TMP("XQORS",$J,XQORS,"INP")=^TMP("XQORS",$J,XQORS-1,"INP") 38 S XQORNOD=^TMP("XQORS",$J,XQORS,"VPT"),XQORNOD(0)=^TMP("XQORS",$J,XQORS,"INP") 39 I XQORS>1,$D(^TMP("XQORS",$J,XQORS-1,"FLG")) S X=^TMP("XQORS",$J,XQORS-1,"FLG"),$P(^TMP("XQORS",$J,XQORS,"FLG"),"^",3)=$S($L($P(X,"^",5)):$P(X,"^",5),1:$P(X,"^",3)) 40 I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"4)")) S:$P(^(4),"^",3)="Y" $P(^TMP("XQORS",$J,XQORS,"FLG"),"^",2)=1 41 I ^TMP("XQORS",$J,0,"FILE")=";DIC(19,",$P(^TMP("XQORS",$J,XQORS,"FLG"),"^")="M" S $P(^TMP("XQORS",$J,XQORS,"FLG"),"^",2)=1 42 I $D(XQORFLG) S:$D(XQORFLG("PS")) $P(^TMP("XQORS",$J,XQORS,"FLG"),"^",2)=+XQORFLG("PS") S:$D(XQORFLG("SH")) $P(^TMP("XQORS",$J,XQORS,"FLG"),"^",3)=+XQORFLG("SH") K XQORFLG 43 I $D(ORITMO) S $P(^TMP("XQORS",$J,XQORS,"FLG"),"^",6)=1 K ORITMO G REDO^XQOR1 44 I $P(^TMP("XQORS",$J,XQORS,"FLG"),"^")="D" N XQORDLG 45 G LOOP^XQOR1 46 EX K XQORNEST(XQORS),XQORFLG,XQORNOD,XQORY,^TMP("XQORS",$J,XQORS) S XQORS=XQORS-1,XQORNEST=XQORS ;pop 47 I XQORS=0 K XQORNEST,XQORS,^TMP("XQORS",$J),XQORSPEW 48 Q 49 EN1 ;Process items on option/protocol only (i.e., skip initial actions) 50 ;From: Anywhere Entry: X,DIC Exit: none 51 S ORITMO=1 G EN 52 Q 53 XQ ;From: Menuman Entry: XQOR Exit: XQOR 54 S X=+XQOR_";DIC(19," I $D(^DD(19,0,"VR")),^("VR")<5.9 G EN 55 G EN1 56 MSG(X,XQORMSG) ;Event point for HL7 messages 57 N DIC S DIC=101 58 I '$D(XQORHSTK) N XQORHSTK S XQORHSTK=-1 K ^TMP("XQORHSTK",$J) 59 S XQORHSTK=XQORHSTK+1 60 K ^TMP("XQORHSTK",$J,XQORHSTK) M ^TMP("XQORHSTK",$J,XQORHSTK)=XQORMSG 61 D EN^XQOR 62 S XQORHSTK=XQORHSTK-1 63 I XQORHSTK>-1 K XQORMSG M XQORMSG=^TMP("XQORHSTK",$J,XQORHSTK) 64 I XQORHSTK=-1 K ^TMP("XQORHSTK",$J) 65 Q
Note:
See TracChangeset
for help on using the changeset viewer.