source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXSEND1.m@ 1801

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