Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXSEND4.m

    r613 r623  
    1 OCXSEND4        ;SLC/RJS,CLA - BUILD RULE TRANSPORTER ROUTINES (Build Library Routine 0) ;2/01/01  09:56
    2         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,96,105,243**;Dec 17,1997;Build 242
    3         ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
    4         ;
    5 EN()    ;
    6         ;
    7         N R,LINE,TEXT,NOW,RUCI
    8         S NOW=$$NOW^OCXSEND3,RUCI=$$NETNAME^OCXSEND
    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^OCXSEND3(TEXT)
    10         ;
    11         M ^TMP("OCXSEND",$J,"RTN")=R
    12         ;
    13         S DIE="^TMP(""OCXSEND"","_$J_",""RTN"",",XCN=0,X=$$RNAME^OCXSEND3(0,1)
    14         W !,X X ^%ZOSF("SAVE") K ^TMP("OCXSEND",$J,"RTN")
    15         ;
    16         Q " "
    17         ;
    18 TEXT    ;
    19         ;;|$$RNAME^OCXSEND3(0,1)| ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE |OCXPATCH| ;|NOW|
    20         ;;|OCXLIN2|
    21         ;;|OCXLIN3|
    22         ;; ;
    23         ;;S ;
    24         ;; ;
    25         ;; Q
    26         ;; ;
    27         ;;WARN(RTN,MSG,LINES) ;
    28         ;; ;
    29         ;; Q:$G(OCXAUTO)
    30         ;; ;
    31         ;; N DASH,LINE,NLINE,PLINE
    32         ;; ;
    33         ;; S DASH="",$P(DASH,"-",(55-$L(MSG)-2))="-"
    34         ;; W !!,"--------------",MSG,DASH
    35         ;; ;
    36         ;; W !,RTN,?10,"[|RUCI|] -> [",$$NETNAME^OCXSEND,"] Line"
    37         ;; ;
    38         ;; I $O(LINES($O(LINES(0)))) W "s: "
    39         ;; E  W ": "
    40         ;; ;
    41         ;; S LINE=0 F  S LINE=$O(LINES(LINE)) Q:'LINE  D
    42         ;; .W:($X>60) !,?40
    43         ;; .S NLINE=LINE F  S PLINE=NLINE,NLINE=$O(LINES(NLINE)) Q:(NLINE-PLINE-1)
    44         ;; .I (PLINE=LINE) W " ",LINE
    45         ;; .E  W " ",LINE,"-",PLINE S LINE=PLINE
    46         ;; ;
    47         ;; W ! Q
    48         ;; ;
    49         ;;TEXT(RTN,LINE) ;
    50         ;; ;
    51         ;; N TEXT X "S TEXT=$T(+"_(+LINE)_"^"_RTN_")" Q TEXT
    52         ;; ;
    53         ;;HEADER ;
    54         ;; ;
    55         ;; W !," Created: |NOW|  at  |RUCI|"
    56         ;; W !," Current Date: ",$$NOW,"  at  ",$$NETNAME^OCXSEND,!!
    57         ;; S LASTFILE=0 K ^TMP("OCXRULE",$J)
    58         ;; S ^TMP("OCXRULE",$J)=($P($H,",",2)+($H*86400)+(1*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
    59         ;; Q
    60         ;; ;
    61         ;;GETFILE(FILE,RECNAME,ARRAY) ;
    62         ;; ;
    63         ;; N CHECK,GLNEXT,GLREF,LINES,REC,DD,FLD
    64         ;; S REC=$$LOOKUP(FILE,RECNAME)
    65         ;; I 'REC W !!,$$FILENAME^OCXSENDD(FILE),": ",RECNAME Q 0
    66         ;; I (REC=-1) W !!,$$FILENAME^OCXSENDD(FILE),": ",RECNAME,"  duplicate local entries.",! Q 0
    67         ;; I (REC=-2) W !!,$$FILENAME^OCXSENDD(FILE)," (",FILE,") local file not found." W ! Q:$$PAUSE -10 Q REC
    68         ;; I (REC<0) W !!,$$FILENAME^OCXSENDD(FILE),": ",RECNAME,"  unknown lookup error." W ! Q:$$PAUSE -10 Q REC
    69         ;; I (REC>0) D
    70         ;; .S CHECK=0,LINES=0
    71         ;; .D GETREC($$FILE^OCXSENDD(FILE,"GLOBAL NAME"),"ARRAY(",REC,.ARRAY)
    72         ;; .S GLREF="ARRAY" F  S GLREF=$Q(@GLREF) Q:'$L(GLREF)  Q:'($E(GLREF,1,6)="ARRAY(")  K:'$L(@GLREF) @GLREF
    73         ;; ;
    74         ;; Q REC
    75         ;; ;
    76         ;;LKUPARRY(DD,KEY,ARRAY) ;
    77         ;; ;
    78         ;; N D0 S D0=0 F  S D0=$O(ARRAY(DD,D0)) Q:'D0  Q:($G(ARRAY(DD,D0,.01,"E"))=KEY)
    79         ;; Q D0
    80         ;; ;
    81         ;;LOOKUP(FILE,KEY) ;
    82         ;; I $O(^TMP("OCXRULE",$J,"B",FILE,KEY,0)) Q 0
    83         ;; N RECNAM,REC,D0,CNT,SHORT S (REC,CNT)=0
    84         ;; S GL=$$FILE^OCXSENDD(FILE,"GLOBAL NAME") Q:'$L(GL) -2 S GL=$E(GL,1,$L(GL)-1)_")"
    85         ;; S SHORT=$E(KEY,1,30),RECNAM=SHORT D  F  S RECNAM=$O(@GL@("B",RECNAM)) Q:'$L(RECNAM)  Q:'($E(RECNAM,1,$L(SHORT))=SHORT)  D
    86         ;; .S D0=0 F  S D0=$O(@GL@("B",RECNAM,D0)) Q:'D0  I ($P($G(@GL@(D0,0)),U,1)=KEY) S CNT=CNT+1,REC=D0_U_RECNAME
    87         ;; Q:(CNT>1) -1
    88         ;; S:$L($P(REC,U,2)) ^TMP("OCXRULE",$J,"A",FILE,$P(REC,U,2))=""
    89         ;; Q +REC
    90         ;; ;
    91         ;;GETREC(GL,PATH,D0,REM) ;
    92         ;; ;
    93         ;; Q:'($P($G(@(GL_"0)")),U,2))
    94         ;; N S1,DATA,DD
    95         ;; S DATA="" D DIQ(GL,D0,.DATA)
    96         ;; S DD=$O(DATA(0)) Q:'DD
    97         ;; ;
    98         ;; I $L($$FILE^OCXSENDD(DD,"NAME")) S PATH=PATH_""""_DD_":"_D0_""""
    99         ;; I '$L($$FILE^OCXSENDD(DD,"NAME")) S PATH=PATH_","""_DD_":"_D0_""""
    100         ;; M @(PATH_")")=DATA(DD,D0)
    101         ;; ;
    102         ;; S S1="" F  S S1=$O(@(GL_D0_","_$$SUB(S1)_")")) Q:'$L(S1)  I ($D(@(GL_D0_","_$$SUB(S1)_")"))>3) D
    103         ;; .N D1,GLREF S GLREF=GL_D0_","_$$SUB(S1)_","
    104         ;; .S D1=0 F  S D1=$O(@(GLREF_D1_")")) Q:'D1  D GETREC(GLREF,PATH,D1,.REM)
    105         ;; ;
    106         ;; Q
    107         ;; ;
    108         ;;SUB(X) Q:'(X=+X) """"_X_"""" Q X
    109         ;; ;
    110         ;;DIQ(DIC,DA,OCXARY) ;
    111         ;; N DR,DIQ S DR=".01:99999",DIQ="OCXARY(",DIQ(0)="EN" D EN^DIQ1
    112         ;; Q
    113         ;; ;
    114         ;;PAUSE() W "  Press Enter " R X:DTIME W ! Q (X[U)
    115         ;; ;
    116         ;;NOW() N X,Y,%DT S X="N",%DT="T" D ^%DT S Y=$$DATE^OCXSENDD(Y) S:(Y["@") Y=$P(Y,"@",1)_" at "_$P(Y,"@",2) Q Y
    117         ;; ;
    118         ;;$
    119         ;1;
    120         ;
     1OCXSEND4 ;SLC/RJS,CLA - BUILD RULE TRANSPORTER ROUTINES (Build Library Routine 0) ;2/01/01  09:56
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,96,105**;Dec 17,1997
     3 ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
     4 ;
     5EN() ;
     6 ;
     7 N R,LINE,TEXT,NOW,RUCI,XCM
     8 S NOW=$$NOW^OCXSEND3,RUCI=$$NETNAME^OCXSEND
     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^OCXSEND3(TEXT)
     10 ;
     11 M ^TMP("OCXSEND",$J,"RTN")=R
     12 ;
     13 S DIE="^TMP(""OCXSEND"","_$J_",""RTN"",",XCN=0,X=$$RNAME^OCXSEND3(0,1)
     14 W !,X X ^%ZOSF("SAVE") W "  ... ",XCM," Lines filed" K ^TMP("OCXSEND",$J,"RTN")
     15 ;
     16 Q XCM
     17 ;
     18TEXT ;
     19 ;;|$$RNAME^OCXSEND3(0,1)| ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE |OCXPATCH| ;|NOW|
     20 ;;|OCXLIN2|
     21 ;;|OCXLIN3|
     22 ;; ;
     23 ;;S ;
     24 ;; ;
     25 ;; Q
     26 ;; ;
     27 ;;WARN(RTN,MSG,LINES) ;
     28 ;; ;
     29 ;; Q:$G(OCXAUTO)
     30 ;; ;
     31 ;; N DASH,LINE,NLINE,PLINE
     32 ;; ;
     33 ;; S DASH="",$P(DASH,"-",(55-$L(MSG)-2))="-"
     34 ;; W !!,"--------------",MSG,DASH
     35 ;; ;
     36 ;; W !,RTN,?10,"[|RUCI|] -> [",$$NETNAME^OCXSEND,"] Line"
     37 ;; ;
     38 ;; I $O(LINES($O(LINES(0)))) W "s: "
     39 ;; E  W ": "
     40 ;; ;
     41 ;; S LINE=0 F  S LINE=$O(LINES(LINE)) Q:'LINE  D
     42 ;; .W:($X>60) !,?40
     43 ;; .S NLINE=LINE F  S PLINE=NLINE,NLINE=$O(LINES(NLINE)) Q:(NLINE-PLINE-1)
     44 ;; .I (PLINE=LINE) W " ",LINE
     45 ;; .E  W " ",LINE,"-",PLINE S LINE=PLINE
     46 ;; ;
     47 ;; W ! Q
     48 ;; ;
     49 ;;TEXT(RTN,LINE) ;
     50 ;; ;
     51 ;; N TEXT X "S TEXT=$T(+"_(+LINE)_"^"_RTN_")" Q TEXT
     52 ;; ;
     53 ;;HEADER ;
     54 ;; ;
     55 ;; W !," Created: |NOW|  at  |RUCI|"
     56 ;; W !," Current Date: ",$$NOW,"  at  ",$$NETNAME^OCXSEND,!!
     57 ;; S LASTFILE=0 K ^TMP("OCXRULE",$J)
     58 ;; S ^TMP("OCXRULE",$J)=($P($H,",",2)+($H*86400)+(1*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
     59 ;; Q
     60 ;; ;
     61 ;;GETFILE(FILE,RECNAME,ARRAY) ;
     62 ;; ;
     63 ;; N CHECK,GLNEXT,GLREF,LINES,REC,DD,FLD
     64 ;; S REC=$$LOOKUP(FILE,RECNAME)
     65 ;; I 'REC W !!,$$FILENAME^OCXSENDD(FILE),": ",RECNAME Q 0
     66 ;; I (REC=-1) W !!,$$FILENAME^OCXSENDD(FILE),": ",RECNAME,"  duplicate local entries.",! Q 0
     67 ;; I (REC=-2) W !!,$$FILENAME^OCXSENDD(FILE)," (",FILE,") local file not found." W ! Q:$$PAUSE -10 Q REC
     68 ;; I (REC<0) W !!,$$FILENAME^OCXSENDD(FILE),": ",RECNAME,"  unknown lookup error." W ! Q:$$PAUSE -10 Q REC
     69 ;; I (REC>0) D
     70 ;; .S CHECK=0,LINES=0
     71 ;; .D GETREC($$FILE^OCXSENDD(FILE,"GLOBAL NAME"),"ARRAY(",REC,.ARRAY)
     72 ;; .S GLREF="ARRAY" F  S GLREF=$Q(@GLREF) Q:'$L(GLREF)  Q:'($E(GLREF,1,6)="ARRAY(")  K:'$L(@GLREF) @GLREF
     73 ;; ;
     74 ;; Q REC
     75 ;; ;
     76 ;;LKUPARRY(DD,KEY,ARRAY) ;
     77 ;; ;
     78 ;; N D0 S D0=0 F  S D0=$O(ARRAY(DD,D0)) Q:'D0  Q:($G(ARRAY(DD,D0,.01,"E"))=KEY)
     79 ;; Q D0
     80 ;; ;
     81 ;;LOOKUP(FILE,KEY) ;
     82 ;; I $O(^TMP("OCXRULE",$J,"B",FILE,KEY,0)) Q 0
     83 ;; N RECNAM,REC,D0,CNT,SHORT S (REC,CNT)=0
     84 ;; S GL=$$FILE^OCXSENDD(FILE,"GLOBAL NAME") Q:'$L(GL) -2 S GL=$E(GL,1,$L(GL)-1)_")"
     85 ;; S SHORT=$E(KEY,1,30),RECNAM=SHORT D  F  S RECNAM=$O(@GL@("B",RECNAM)) Q:'$L(RECNAM)  Q:'($E(RECNAM,1,$L(SHORT))=SHORT)  D
     86 ;; .S D0=0 F  S D0=$O(@GL@("B",RECNAM,D0)) Q:'D0  I ($P($G(@GL@(D0,0)),U,1)=KEY) S CNT=CNT+1,REC=D0_U_RECNAME
     87 ;; Q:(CNT>1) -1
     88 ;; S:$L($P(REC,U,2)) ^TMP("OCXRULE",$J,"A",FILE,$P(REC,U,2))=""
     89 ;; Q +REC
     90 ;; ;
     91 ;;GETREC(GL,PATH,D0,REM) ;
     92 ;; ;
     93 ;; Q:'($P($G(@(GL_"0)")),U,2))
     94 ;; N S1,DATA,DD
     95 ;; S DATA="" D DIQ(GL,D0,.DATA)
     96 ;; S DD=$O(DATA(0)) Q:'DD
     97 ;; ;
     98 ;; I $L($$FILE^OCXSENDD(DD,"NAME")) S PATH=PATH_""""_DD_":"_D0_""""
     99 ;; I '$L($$FILE^OCXSENDD(DD,"NAME")) S PATH=PATH_","""_DD_":"_D0_""""
     100 ;; M @(PATH_")")=DATA(DD,D0)
     101 ;; ;
     102 ;; S S1="" F  S S1=$O(@(GL_D0_","_$$SUB(S1)_")")) Q:'$L(S1)  I ($D(@(GL_D0_","_$$SUB(S1)_")"))>3) D
     103 ;; .N D1,GLREF S GLREF=GL_D0_","_$$SUB(S1)_","
     104 ;; .S D1=0 F  S D1=$O(@(GLREF_D1_")")) Q:'D1  D GETREC(GLREF,PATH,D1,.REM)
     105 ;; ;
     106 ;; Q
     107 ;; ;
     108 ;;SUB(X) Q:'(X=+X) """"_X_"""" Q X
     109 ;; ;
     110 ;;DIQ(DIC,DA,OCXARY) ;
     111 ;; N DR,DIQ S DR=".01:99999",DIQ="OCXARY(",DIQ(0)="EN" D EN^DIQ1
     112 ;; Q
     113 ;; ;
     114 ;;PAUSE() W "  Press Enter " R X:DTIME W ! Q (X[U)
     115 ;; ;
     116 ;;NOW() N X,Y,%DT S X="N",%DT="T" D ^%DT S Y=$$DATE^OCXSENDD(Y) S:(Y["@") Y=$P(Y,"@",1)_" at "_$P(Y,"@",2) Q Y
     117 ;; ;
     118 ;;$
     119 ;1;
     120 ;
Note: See TracChangeset for help on using the changeset viewer.