| 1 | OCXBDT9 ;SLC/RJS,CLA - BUILD OCX PACKAGE DIAGNOSTIC ROUTINES (Build Runtime Library Routine OCXDI5) ;8/04/98 13:21
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
|
|---|
| 3 | ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
|
|---|
| 4 | ;
|
|---|
| 5 | EN() ;
|
|---|
| 6 | ;
|
|---|
| 7 | N R,LINE,TEXT,NOW,RUCI,P1NAME,D0,D1,P2NUM,P2NAM,XCM
|
|---|
| 8 | S NOW=$$NOW^OCXBDT3,RUCI=$$CUCI^OCXBDT
|
|---|
| 9 | F LINE=1:1:999 S TEXT=$P($T(TEXT+LINE),";",2,999) Q:TEXT S TEXT=$P(TEXT,";",2,999) S R(LINE,0)=$$CONV^OCXBDT3(TEXT)
|
|---|
| 10 | ;
|
|---|
| 11 | S D0=0 F S D0=$O(^ORD(101,D0)) Q:'D0 D
|
|---|
| 12 | .S PNAME=$P($G(^ORD(101,D0,0)),U,1)
|
|---|
| 13 | .Q:'$L(PNAME)
|
|---|
| 14 | .S D1=0 F S D1=$O(^ORD(101,D0,10,D1)) Q:'D1 D
|
|---|
| 15 | ..S P2NUM=+^ORD(101,D0,10,D1,0),P2NAME=$P($G(^ORD(101,P2NUM,0)),U,1)
|
|---|
| 16 | ..I ($E(P2NAME,1,15)="OCX ORDER CHECK") D ADD
|
|---|
| 17 | S R($O(R(""),-1)+1,0)=" ;1;"
|
|---|
| 18 | S R($O(R(""),-1)+1,0)="$"
|
|---|
| 19 | ;
|
|---|
| 20 | M ^TMP("OCXBDT",$J,"RTN")=R
|
|---|
| 21 | S DIE="^TMP(""OCXBDT"","_$J_",""RTN"",",XCN=0,X="OCXDI5"
|
|---|
| 22 | W !,X X ^%ZOSF("SAVE") W " ... ",XCM," Lines filed" K ^TMP("OCXBDT",$J,"RTN")
|
|---|
| 23 | ;
|
|---|
| 24 | Q XCM
|
|---|
| 25 | ;
|
|---|
| 26 | ADD S R($O(R(""),-1)+1,0)=" ;;"_PNAME_U_P2NAME W !!,"Protocol: ",PNAME," -> ",P2NAME Q
|
|---|
| 27 | ;
|
|---|
| 28 | TEXT ;
|
|---|
| 29 | ;;OCXDI5 ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC UTILITY ROUTINE ;|NOW|
|
|---|
| 30 | ;;|OCXLIN2|
|
|---|
| 31 | ;;|OCXLIN3|
|
|---|
| 32 | ;; ;
|
|---|
| 33 | ;;EN() ;
|
|---|
| 34 | ;; ; Protocol Utilities
|
|---|
| 35 | ;; ;
|
|---|
| 36 | ;; N OCXLINE,OCXTEXT,OCXQUIT
|
|---|
| 37 | ;; S OCXQUIT=0
|
|---|
| 38 | ;; F OCXLINE=1:1:500 S OCXTEXT=$P($T(DATA+OCXLINE),";",2,999) Q:OCXTEXT I $L(OCXTEXT) D Q:OCXQUIT
|
|---|
| 39 | ;; .D DOT^OCXDIAG
|
|---|
| 40 | ;; .S OCXTEXT=$P(OCXTEXT,";",2,999)
|
|---|
| 41 | ;; .S OCXQUIT=$$ADD($P(OCXTEXT,U,1),$P(OCXTEXT,U,2))
|
|---|
| 42 | ;; Q OCXQUIT
|
|---|
| 43 | ;; ;
|
|---|
| 44 | ;;ADD(OCXX,OCXITEM) ;
|
|---|
| 45 | ;; ;
|
|---|
| 46 | ;; N OCXD0,OCXD1,OCXD2,DIE,DIC,DR,X,Y,DA,OCXQUIT
|
|---|
| 47 | ;; S OCXD0=$$DIC("^ORD(101,",OCXX) Q:'OCXD0 0
|
|---|
| 48 | ;; S OCXD1=$$DIC("^ORD(101,",OCXITEM) Q:'OCXD1 0
|
|---|
| 49 | ;; S OCXD2=0 F S OCXD2=$O(^ORD(101,OCXD0,10,OCXD2)) Q:'OCXD2 Q:(+^ORD(101,OCXD0,10,OCXD2,0)=OCXD1)
|
|---|
| 50 | ;; Q:OCXD2 0 S OCXQUIT=0
|
|---|
| 51 | ;; I OCXFLGR W !!," '"_OCXITEM_"' is missing as an Item to the '"_OCXX_"' protocol."
|
|---|
| 52 | ;; Q:'OCXFLGC 0 I OCXFLGA S OCXQUIT=$$READ("Y"," Do you want to add '"_OCXITEM_"' as an Item to '"_OCXX_"' ?","YES") I 'OCXQUIT Q (OCXQUIT[U)
|
|---|
| 53 | ;; S:'$D(^ORD(101,OCXD0,10,0)) ^ORD(101,OCXD0,10,0)="^101.01PA^^"
|
|---|
| 54 | ;; S (DIE,DIC)="^ORD(101,"_OCXD0_",10,"
|
|---|
| 55 | ;; F DA=1:1 Q:'$D(^ORD(101,OCXD0,10,DA,0))
|
|---|
| 56 | ;; S DA(1)=OCXD0
|
|---|
| 57 | ;; S DR=".01///"_OCXITEM
|
|---|
| 58 | ;; S OCXSCR=1 D ^DIE
|
|---|
| 59 | ;; I OCXFLGR W !," added"
|
|---|
| 60 | ;; I 'OCXFLGR W !," '"_OCXITEM_"' added as an Item to the '"_OCXX_"' protocol"
|
|---|
| 61 | ;; ;
|
|---|
| 62 | ;; Q 0
|
|---|
| 63 | ;; ;
|
|---|
| 64 | ;;DIC(DIC,X) S DIC(0)="",OCXSCR=1 D ^DIC Q:(+Y>0) +Y Q 0
|
|---|
| 65 | ;; ;
|
|---|
| 66 | ;;READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
|
|---|
| 67 | ;; N OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
|
|---|
| 68 | ;; Q:'$L($G(OCXZ0)) U
|
|---|
| 69 | ;; S DIR(0)=OCXZ0
|
|---|
| 70 | ;; S:$L($G(OCXZA)) DIR("A")=OCXZA
|
|---|
| 71 | ;; S:$L($G(OCXZB)) DIR("B")=OCXZB
|
|---|
| 72 | ;; F OCXLINE=1:1:($G(OCXZL)-1) W !
|
|---|
| 73 | ;; D ^DIR
|
|---|
| 74 | ;; I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
|
|---|
| 75 | ;; Q Y
|
|---|
| 76 | ;; ;
|
|---|
| 77 | ;;DATA ;:
|
|---|
| 78 | ;1;
|
|---|
| 79 | ;
|
|---|
