Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: OCXSEND1

OCXSEND1.m

Go to the documentation of this file. 
  1. OCXSEND1 ;SLC/RJS,CLA - BUILD RULE TRANSPORTER ROUTINES (Get List of Objects to Transport) ;2/01/01  09:06
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
  1.  ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
  1.  ;
  1. S ;
  1.  ;
  1.  N OCXFILE,OCXD0
  1.  ;
  1.  F  S OCXFILE=$$GETFILE Q:'OCXFILE  I (OCXFILE>1) F  D ADDON Q:'$$GETREC(OCXFILE)
  1.  ;
  1.  Q
  1.  ;
  1. GETREC(OCXFILE) ;
  1.  ;
  1.  N OCXDIAG,OCXD0,OCXD1,OCXX,OCXADD,OCXSCR
  1.  S OCXDIAG="Select an"_$S($O(^TMP("OCXSEND",$J,"LIST",+OCXFILE,0)):"other",1:"")
  1.  S OCXDIAG=OCXDIAG_" "_$P(OCXFILE,U,2)_": "
  1.  S OCXID="I $D(^TMP(""OCXSEND"",$J,"_(+OCXFILE)_",""B"",$P(^(0),U,1))) W ""  ***** Already selected for transport. *****"""
  1.  S:(+OCXFILE=860.8) OCXID="W:$L($P(^(0),U,2)) ?35,""$$"",$P(^(0),U,2),""() "" "_OCXID
  1.  S OCXSCR=""
  1.  W !!,OCXDIAG R OCXX:DTIME E  W "  <timeout>",$C(7) Q 0
  1.  Q:(OCXX[U) 0 Q:'$L(OCXX) 0
  1.  S OCXADD=1 I ($E(OCXX,1)="-") S OCXX=$E(OCXX,2,$L(OCXX)),OCXADD=0
  1.  ;
  1.  I (OCXX="?") D
  1.  .I '$O(^TMP("OCXSEND",$J,"LIST",+OCXFILE,0)) W !!,"None Selected for transport"
  1.  .E  W !!,"Already selected for transport:" D
  1.  ..S OCXD0="" F  S OCXD0=$O(^TMP("OCXSEND",$J,"LIST",+OCXFILE,"B",OCXD0)) Q:'$L(OCXD0)  D
  1.  ...W !,?5,OCXD0
  1.  ...I (+OCXFILE=860.8) D
  1.  ....S OCXD1=$O(^TMP("OCXSEND",$J,"LIST",+OCXFILE,"B",OCXD0,0)) Q:'OCXD1
  1.  ....W:$L($P($G(^OCXS(860.8,+OCXD1,0)),U,2)) "  $$",$P($G(^OCXS(860.8,+OCXD1,0)),U,2),"()"
  1.  .W !!,"Press <Enter> to continue..." R OCXD0:DTIME E  Q
  1.  .S OCXSCR="I '$D(^TMP(""OCXSEND"",$J,"_(+OCXFILE)_",""B"",$P(^(0),U,1)))"
  1.  .S OCXX="??"
  1.  ;
  1.  I (OCXX["*") D  Q 1
  1.  .N OCXPAT,OCXCNT,OCXLEN,OCXNAME
  1.  .S OCXPAT=""
  1.  .F  Q:(OCXX'["**")  S OCXX=$P(OCXX,"**",1)_"*"_$P(OCXX,"**",2,999)
  1.  .S OCXLEN=$L(OCXX,"*")
  1.  .F OCXCNT=1:1:OCXLEN D
  1.  ..S:$L($P(OCXX,"*",1)) OCXPAT=OCXPAT_"1"""_$P(OCXX,"*",1)_""""
  1.  ..S:(OCXX["*") OCXPAT=OCXPAT_".E"
  1.  ..S OCXX=$P(OCXX,"*",2,999)
  1.  .S OCXD0=0 F  S OCXD0=$O(^OCXS(+OCXFILE,OCXD0)) Q:'OCXD0  D
  1.  ..S OCXNAME=$P($G(^OCXS(+OCXFILE,OCXD0,0)),U,1)
  1.  ..X "I OCXNAME?"_OCXPAT E  Q
  1.  ..I OCXADD D ADDREC(+OCXFILE,OCXD0)
  1.  ..I 'OCXADD D DELREC(+OCXFILE,OCXD0)
  1.  ;
  1.  S OCXD0=$$DIC(+OCXFILE,"EMQ",OCXDIAG,OCXX,OCXSCR,OCXID)
  1.  I OCXD0 H 1 D
  1.  .I OCXADD D ADDREC(OCXFILE,OCXD0)
  1.  .I 'OCXADD D DELREC(OCXFILE,OCXD0)
  1.  ;
  1.  Q 1
  1.  ;
  1. ADDON ;
  1.  ;
  1.  I $O(^TMP("OCXSEND",$J,"LIST",0)) D
  1.  .S OCXD0=0 F  S OCXD0=$O(^OCXS(860.9,OCXD0)) Q:'OCXD0  D
  1.  ..I $D(^OCXS(860.9,OCXD0,0)) D CHECK^OCXSENDB(860.9,OCXD0)
  1.  .D CHECK^OCXSENDB(860.8,"FILE")
  1.  .D CHECK^OCXSENDB(860.8,"GETDATA")
  1.  .D CHECK^OCXSENDB(860.8,"DT2INT")
  1.  .D CHECK^OCXSENDB(860.8,"INT2DT")
  1.  .D CHECK^OCXSENDB(860.8,"LIST")
  1.  .D CHECK^OCXSENDB(860.8,"CLIST")
  1.  .D CHECK^OCXSENDB(860.8,"EQTERM")
  1.  .D CHECK^OCXSENDB(860.8,"NEWRULE")
  1.  .D CHECK^OCXSENDB(860.8,"POINTER")
  1.  .D CHECK^OCXSENDB(860.4,"PATIENT IEN")
  1.  ;
  1.  Q
  1.  ;
  1. ADDREC(FILE,REC) ;
  1.  ;
  1.  N LLAB
  1.  S FILE=+FILE,REC=+REC
  1.  Q:'$D(^OCXS(FILE,REC))
  1.  Q:$D(^TMP("OCXSEND",$J,"LIST",FILE,REC))
  1.  S ^TMP("OCXSEND",$J,"LIST",FILE,REC)=$P($G(^OCXS(FILE,REC,0)),U,1)
  1.  S ^TMP("OCXSEND",$J,"LIST",FILE,"B",$P($G(^OCXS(FILE,REC,0)),U,1),REC)=""
  1.  W !,$P(^OCXS(FILE,0),U,1)," --> ",$P($G(^OCXS(FILE,REC,0)),U,1)," added to list."
  1.  ;
  1.  S LLAB=$TR(FILE,".","")_"^OCXSENDB"
  1.  X "I $L($T("_LLAB_"))" E  Q
  1.  D @LLAB
  1.  Q
  1.  ;
  1. DELREC(FILE,REC) ;
  1.  ;
  1.  N OCXNAME
  1.  S OCXNAME=$G(^TMP("OCXSEND",$J,"LIST",+FILE,+REC)) Q:'$L(OCXNAME)
  1.  K ^TMP("OCXSEND",$J,"LIST",+FILE,+REC)
  1.  K ^TMP("OCXSEND",$J,"LIST",+FILE,"B",OCXNAME,+REC)
  1.  W !,OCXNAME," removed from list."
  1.  Q
  1.  ;
  1. GETFILE() ;
  1.  ;
  1.  N OCXDIAG,OCXD0,OCXX,OCXADD
  1.  S OCXDIAG="Select a"_$S($O(^TMP("OCXSEND",$J,"LIST",0)):"nother",1:"")_" File: "
  1.  S OCXSCR="I $D(^OCXS(+$P(^(0),U,2),0)),$O(^OCXS(+$P(^(0),U,2),0))"
  1.  S OCXID="N OCXCNT S OCXCNT=$$CNT^OCXSEND1(+$P(^(0),U,2)) I OCXCNT W ?50,$J(OCXCNT,5),"" selected for transport."""
  1.  W !!,OCXDIAG R OCXX:DTIME E  W "  <timeout>",$C(7) Q 0
  1.  Q:(OCXX[U) 0 Q:'$L(OCXX) 0
  1.  ;
  1.  I (OCXX="?") S OCXX="??"
  1.  ;
  1.  S OCXD0=$$DIC(1,"EMQ",OCXDIAG,OCXX,OCXSCR,OCXID)
  1.  ;
  1.  Q:OCXD0 OCXD0 Q:$L(OCXX) 1 Q 0
  1.  ;
  1. CNT(OCXFILE) ;
  1.  ;
  1.  N CNT,OCXD0
  1.  S OCXD0=0 F CNT=0:1 S OCXD0=$O(^TMP("OCXSEND",$J,"LIST",OCXFILE,OCXD0)) Q:'OCXD0
  1.  Q CNT
  1.  ;
  1. DIC(OCXDIC,OCXDIC0,OCXDICA,OCXX,OCXDICS,OCXW) ;
  1.  ;
  1.  N DIC,X,Y
  1.  S DIC=$G(OCXDIC) Q:'$L(DIC) -1
  1.  S DIC(0)=$G(OCXDIC0) S:$L($G(OCXX)) X=OCXX
  1.  S:$L($G(OCXDICS)) DIC("S")=OCXDICS
  1.  S:$L($G(OCXDICA)) DIC("A")=OCXDICA
  1.  S:$L($G(OCXW)) DIC("W")=OCXW
  1.  D ^DIC Q:(Y<1) 0 Q Y
  1.  ;