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

OCXBDT4.m

Go to the documentation of this file. 
  1. OCXBDT4 ;SLC/RJS,CLA - BUILD OCX PACKAGE DIAGNOSTIC ROUTINES (Build Runtime Library Routine OCXDI0) ;8/04/98  13:21
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
  1.  ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
  1.  ;
  1. EN() ;
  1.  ;
  1.  N R,LINE,TEXT,NOW,RUCI,XCM
  1.  S NOW=$$NOW^OCXBDT3,RUCI=$$CUCI^OCXBDT
  1.  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)
  1.  ;
  1.  M ^TMP("OCXBDT",$J,"RTN")=R
  1.  ;
  1.  S DIE="^TMP(""OCXBDT"","_$J_",""RTN"",",XCN=0,X="OCXDI0"
  1.  W !,X X ^%ZOSF("SAVE") W "  ... ",XCM," Lines filed" K ^TMP("OCXBDT",$J,"RTN")
  1.  ;
  1.  Q XCM
  1.  ;
  1. TEXT ;
  1.  ;;OCXDI0 ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC UTILITY ROUTINE ;|NOW|
  1.  ;;|OCXLIN2|
  1.  ;;|OCXLIN3|
  1.  ;; ;
  1.  ;;S ;
  1.  ;; ;
  1.  ;; Q
  1.  ;; ;
  1.  ;;RTN(RSUM) ;
  1.  ;; ;
  1.  ;; D DOT^OCXDIAG
  1.  ;; ;
  1.  ;; N CHAR,CSUM,DASH,LINE,MSG,RNDX,RPC,RTN,TEXT,X,RCSM,RDIFF
  1.  ;; ;
  1.  ;; S RCSM(3)="",RTN=$P(RSUM(0),U,1)
  1.  ;; F RNDX=1:1 Q:'$D(RSUM(RNDX))  F RPC=1:1:$L(RSUM(RNDX),U) S RCSM($O(RCSM(""),-1)+1)=$P(RSUM(RNDX),U,RPC)
  1.  ;; K RCSM(3)
  1.  ;; ;
  1.  ;; S X=RTN X ^%ZOSF("TEST") E  D WARN(RTN,"Routine not in local system") Q 0
  1.  ;; ;
  1.  ;; F LINE=4:1 S TEXT=$$TEXT(RTN,LINE) Q:'$L(TEXT)  I '$D(RCSM(LINE)) S RDIFF(LINE)=""
  1.  ;; S LINE=0 F  S LINE=$O(RCSM(LINE)) Q:'LINE  S TEXT=$$TEXT(RTN,LINE) D
  1.  ;; .S CSUM=0 F CHAR=1:1:$L(TEXT) S CSUM=CSUM+($A(TEXT,CHAR)*CHAR)
  1.  ;; .I '(RCSM(LINE)=(+(CSUM_"."_$L(TEXT)_"1"))) S RDIFF(LINE)=""
  1.  ;; ;
  1.  ;; Q:'$O(RDIFF(0)) 0
  1.  ;; ;
  1.  ;; D WARN(RTN,"Checksums do not match",.RDIFF)
  1.  ;; ;
  1.  ;; Q 0
  1.  ;; ;
  1.  ;;WARN(RTN,MSG,LINES) ;
  1.  ;; ;
  1.  ;; Q:$G(OCXAUTO)
  1.  ;; ;
  1.  ;; N DASH,LINE,NLINE,PLINE
  1.  ;; ;
  1.  ;; S DASH="",$P(DASH,"-",(55-$L(MSG)-2))="-"
  1.  ;; W !!,"----WARNING-","--",MSG,DASH
  1.  ;; ;
  1.  ;; W !,RTN,?10,"[|RUCI|] -> [",$$CUCI^OCXBDT,"] Line"
  1.  ;; ;
  1.  ;; I $O(LINES($O(LINES(0)))) W "s: "
  1.  ;; E  W ": "
  1.  ;; ;
  1.  ;; S LINE=0 F  S LINE=$O(LINES(LINE)) Q:'LINE  D
  1.  ;; .W:($X>60) !,?40
  1.  ;; .S NLINE=LINE F  S PLINE=NLINE,NLINE=$O(LINES(NLINE)) Q:(NLINE-PLINE-1)
  1.  ;; .I (PLINE=LINE) W " ",LINE
  1.  ;; .E  W " ",LINE,"-",PLINE S LINE=PLINE
  1.  ;; ;
  1.  ;; W ! Q
  1.  ;; ;
  1.  ;;TEXT(RTN,LINE) ;
  1.  ;; ;
  1.  ;; N TEXT X "S TEXT=$T(+"_(+LINE)_"^"_RTN_")" Q TEXT
  1.  ;; ;
  1.  ;;HEADER ;
  1.  ;; ;
  1.  ;; W !," Created: |NOW|  in UCI: |RUCI|"
  1.  ;; W !," Current Date: ",$$NOW," Current UCI: ",$$CUCI^OCXBDT,!!
  1.  ;; S LASTFILE=0
  1.  ;; K ^TMP("OCXDIAG",$J)
  1.  ;; S ^TMP("OCXDIAG",$J)=($P($H,",",2)+($H*86400)+(1*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
  1.  ;; Q
  1.  ;; ;
  1.  ;;LISTFILE(GLREF,SCANDUP) ;
  1.  ;; ;
  1.  ;; Q:($L(GLREF)<2) 0
  1.  ;; N D0,NAME,FILE,QUIT,CNT,FILENUM
  1.  ;; S QUIT=0,FILE=$P($G(@GLREF@(0)),U,1),FILENUM=+$P($G(@GLREF@(0)),U,2)
  1.  ;; I '$L(FILE) W !!,"Cannot find File: ",GLREF Q $$PAUSE
  1.  ;; I SCANDUP S (QUIT,D0)=0 F CNT=0:1 S D0=$O(@GLREF@(D0)) Q:'D0  S NAME=$P($G(@GLREF@(D0,0)),U,1) D  Q:QUIT
  1.  ;; .D DOT^OCXDIAG
  1.  ;; .I '$L(NAME) W !,GLREF,"  ",FILE," -> Record #",D0,"  does not have a name." S QUIT=$$PAUSE Q
  1.  ;; .I OCXFLGR,'$D(^TMP("OCXDIAG",$J,"A",FILENUM,NAME)) D
  1.  ;; ..W !!," Extra Record in (L) ",$$CUCI^OCXBDT," - ",FILE,": ",NAME,"."
  1.  ;; ..S QUIT=$$DELREC^OCXDI2(FILENUM,D0)
  1.  ;; Q QUIT
  1.  ;; ;
  1.  ;;GETFILE(FILE,RECNAME,ARRAY) ;
  1.  ;; ;
  1.  ;; N CHECK,GLNEXT,GLREF,LINES,REC,DD,FLD
  1.  ;; S REC=$$LOOKUP(FILE,RECNAME)
  1.  ;; I 'REC W:OCXFLGR !!,$$FILENAME^OCXBDTD(FILE),": ",RECNAME,"  not found." Q 0
  1.  ;; I (REC=-1) W:OCXFLGR !!,$$FILENAME^OCXBDTD(FILE),": ",RECNAME,"  duplicate local entries.",! S REC=$$DELDUP^OCXDI2(FILE,RECNAME)
  1.  ;; I (REC=-2) W:OCXFLGR !!,$$FILENAME^OCXBDTD(FILE)," (",FILE,") local file not found." W ! Q:$$PAUSE -10 Q REC
  1.  ;; I (REC<0) W:OCXFLGR !!,$$FILENAME^OCXBDTD(FILE),": ",RECNAME,"  unknown error." W ! Q:$$PAUSE -10 Q REC
  1.  ;; I (REC>0) D
  1.  ;; .S CHECK=0,LINES=0
  1.  ;; .D GETREC($$FILE^OCXBDTD(FILE,"GLOBAL NAME"),"ARRAY(",REC,.ARRAY)
  1.  ;; .S GLREF="ARRAY" F  S GLREF=$Q(@GLREF) Q:'$L(GLREF)  Q:'($E(GLREF,1,6)="ARRAY(")  K:'$L(@GLREF) @GLREF
  1.  ;; ;
  1.  ;; Q REC
  1.  ;; ;
  1.  ;;LKUPARRY(DD,KEY,ARRAY) ;
  1.  ;; ;
  1.  ;; N D0 S D0=0 F  S D0=$O(ARRAY(DD,D0)) Q:'D0  Q:($G(ARRAY(DD,D0,.01,"E"))=KEY)
  1.  ;; Q D0
  1.  ;; ;
  1.  ;;LOOKUP(FILE,KEY) ;
  1.  ;; I $O(^TMP("OCXDIAG",$J,"B",FILE,KEY,0)) Q 0
  1.  ;; N RECNAM,REC,D0,CNT,SHORT S (REC,CNT)=0
  1.  ;; S GL=$$FILE^OCXBDTD(FILE,"GLOBAL NAME") Q:'$L(GL) -2 S GL=$E(GL,1,$L(GL)-1)_")"
  1.  ;; 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
  1.  ;; .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
  1.  ;; Q:(CNT>1) -1
  1.  ;; S:$L($P(REC,U,2)) ^TMP("OCXDIAG",$J,"A",FILE,$P(REC,U,2))=""
  1.  ;; Q +REC
  1.  ;; ;
  1.  ;;GETREC(GL,PATH,D0,REM) ;
  1.  ;; ;
  1.  ;; Q:'($P($G(@(GL_"0)")),U,2))
  1.  ;; N S1,DATA,DD
  1.  ;; S DATA="" D DIQ(GL,D0,.DATA)
  1.  ;; S DD=$O(DATA(0)) Q:'DD
  1.  ;; ;
  1.  ;; I $L($$FILE^OCXBDTD(DD,"NAME")) S PATH=PATH_""""_DD_":"_D0_""""
  1.  ;; I '$L($$FILE^OCXBDTD(DD,"NAME")) S PATH=PATH_","""_DD_":"_D0_""""
  1.  ;; M @(PATH_")")=DATA(DD,D0)
  1.  ;; ;
  1.  ;; S S1="" F  S S1=$O(@(GL_D0_","_$$SUB(S1)_")")) Q:'$L(S1)  I ($D(@(GL_D0_","_$$SUB(S1)_")"))>3) D
  1.  ;; .N D1,GLREF S GLREF=GL_D0_","_$$SUB(S1)_","
  1.  ;; .S D1=0 F  S D1=$O(@(GLREF_D1_")")) Q:'D1  D GETREC(GLREF,PATH,D1,.REM)
  1.  ;; ;
  1.  ;; Q
  1.  ;; ;
  1.  ;;SUB(X) Q:'(X=+X) """"_X_"""" Q X
  1.  ;; ;
  1.  ;;DIQ(DIC,DA,OCXARY) ;
  1.  ;; N DR,DIQ S DR=".01:99999",DIQ="OCXARY(",DIQ(0)="EN" D EN^DIQ1
  1.  ;; Q
  1.  ;; ;
  1.  ;;PAUSE() Q:'OCXFLGC 0 W "  Press Enter " R X:DTIME W ! Q (X[U)
  1.  ;; ;
  1.  ;;NOW() N X,Y,%DT S X="N",%DT="T" D ^%DT S Y=$$DATE^OCXBDTD(Y) S:(Y["@") Y=$P(Y,"@",1)_" at "_$P(Y,"@",2) Q Y
  1.  ;; ;
  1.  ;;$
  1.  ;1;
  1.  ;