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

IBCEFG0.m

Go to the documentation of this file. 
  1. IBCEFG0 ;ALB/TMP - FORMS GENERATOR EXTRACT (CONT) ;17-JAN-96
  1.  ;;2.0;INTEGRATED BILLING;**52,51**;21-MAR-94
  1.  ;
  1. ELE(IBXDA,IBXPARM,IBXFORM) ; Find element to extract for form fld
  1.  N IBX
  1.  I $G(IBXPARM(1))="BILL-SEARCH" D  I $G(IBX)>0 G ELEQ ;Custom - bill extract
  1.  .S IBX=$$EDIBILL^IBCEFG1(+$G(IBXFORM),IBXDA,$G(IBXPARM(2)),$G(IBXPARM(3)))
  1.  S IBX=+$O(^IBA(364.7,"B",IBXDA,""))
  1.  I 'IBX,$G(IBXFORM),$O(^IBA(364.6,"APAR",IBXFORM,IBXDA,"")) S IBX=+$O(^("")),IBX=+$O(^IBA(364.7,"B",IBX,0)) I IBX G ELEQ
  1. ELEQ Q IBX
  1.  ;
  1. DATA(IBXELE,IBX00,IBXFILE,IBXIEN,IBXARRAY,IBXERR) ; Find data assoc with form fld def
  1.  N IBXPG,IBXCOL,IBXLN,IBXDA,IBXFF
  1.  I $P(IBX00,U,3)="C" S IBXDATA=$P(IBX00,U,8) G DATAQ
  1.  I $P(IBX00,U,3)="E",$G(^IBA(364.5,IBXELE,1))'="" X ^(1) G DATAQ
  1.  I $P(IBX00,U,3)="F" D
  1.  .I $P(IBX00,U,6)[":" I $$GET1^DIQ(IBXFILE,IBXIEN_",",$P($P(IBX00,U,6),":"))="" S IBXDATA="" Q
  1.  .S IBXDATA=$$GET1^DIQ(IBXFILE,IBXIEN_",",$P(IBX00,U,6),$S("I"[$P(IBX00,U,7):"I",1:""),IBXARRAY)
  1.  .I $D(^TMP("DIERR",$J,1)) S IBXERR="FILEMAN FIELD: "_$P(IBX00,U)_" "_^(1,"TEXT",1)
  1. DATAQ Q $G(IBXDATA)
  1.  ;
  1. DUP(DA,X,CK) ; Duplicate check on form field definitions
  1.  ;Returns 1 if a duplicate of this form page/line/column is found
  1.  N PG,LN,COL,ND,FORM,DUP,Z
  1.  S DUP=0
  1.  G:$G(DA)="" DUPQ
  1.  S ND=$G(^IBA(364.6,DA,0))
  1.  S FORM=$S($G(CK)=1:X,1:$P(ND,U)),PG=$S($G(CK)=2:X,1:$P(ND,U,4)),LN=$S($G(CK)=3:X,1:$P(ND,U,5)),COL=$S($G(CK)=4:X,1:$P(ND,U,8))
  1.  ;
  1.  I FORM'="",PG'="",LN'="",COL'="" D
  1.  .S Z=$O(^IBA(364.6,"ASEQ",FORM,PG,LN,COL,""))
  1.  .Q:$S(Z="":1,1:Z=DA&($O(^IBA(364.6,"ASEQ",FORM,PG,LN,COL,""),-1)=DA))
  1.  .S DUP=1
  1.  ;
  1. DUPQ Q DUP
  1.  ;
  1. BILLPARM(IBXIEN,IBXPARM) ; Sets up parameters for extracting bill data
  1.  ;IBXIEN = internal entry # of the entry to be extracted
  1.  ;IBXPARM = array that the parameters are set into.  Pass by reference
  1.  ;   (2)=insurance co int entry #, (3)=bill type (I/O)
  1.  N IB0,IBCBH
  1.  S IB0=$G(^DGCR(399,IBXIEN,0)),IBCBH=$P(IB0,U,21) S:"PST"'[IBCBH!(IBCBH="") IBCBH="P"
  1.  S IBXPARM(1)="BILL-SEARCH",IBXPARM(2)=$P($G(^DGCR(399,IBXIEN,"I"_($F("PST",IBCBH)-1))),U),IBXPARM(3)=$S($P(IB0,U,5)<3:"I",1:"O")
  1.  Q
  1.  ;
  1. PARTEXT(FORMAT,PG,LN,IBXIEN,IBXFORM,IBXPARM,IBXERR) ; Extract part of a printed form
  1.  ;FORMAT = flag used to say whether you want (1) formatted (by line)
  1.  ;        or (0) unformatted (by pg/line/col) returned
  1.  ;PG = page to start/end in 2 '^' pieces (start page^end page)
  1.  ;LN = line to start/end in 2 '^' pieces (start line^end line)
  1.  ; the start value of the preceeding 2 parameters are required
  1.  ; if no end value, start value is assumed to be end value, too
  1.  ;IBXIEN = the entry # of the record to be extracted
  1.  ;IBXFORM = ien of the local or parent form in file 353 to be extracted
  1.  ;IBXPARM = passed by reference. Extract parameters.
  1.  ;IBXERR = passed by reference.  If an error condition is found, this is
  1.  ;      the text of the error.
  1.  ;
  1.  ;Returns ^TMP("IBXDISP",$J,PG,LN)=print line(s) if FORMAT=1
  1.  ;Returns ^TMP("IBXDISP",$J,1,PG,LN,COL)=data at PG/LN/COL if +FORMAT=0
  1.  ;
  1.  ;we may later add an automatic data element dependency logic where
  1.  ; we can flag a data element as needing another d.e. extracted first
  1.  ; and we execute the other logic automatically if not already done.
  1.  ;
  1.  N IBXDA,IBXPG,IBXLN,IBXCOL,IBXF,IBX2,IBXREC,IBXFILE,Z
  1.  K ^TMP("IBXDATA",$J),^TMP("DIERR",$J),^TMP("IBXEDIT",$J),^TMP("IBXDISP",$J)
  1.  S IBX2=$G(^IBE(353,+$G(IBXFORM),2))
  1.  I $P(IBX2,U,2)'="P" S IBXERR="NOT A PRINTABLE FORM!!" Q
  1.  I '$D(^DGCR(399,IBXIEN,0)) S IBXERR="BILL DOES NOT EXIST" Q
  1.  S:$P(PG,U,2)="" $P(PG,U,2)=$P(PG,U) S:$P(LN,U,2)="" $P(LN,U,2)=$P(LN,U)
  1.  S IBXF=$S($P(IBX2,U,5):$P(IBX2,U,5),1:IBXFORM)
  1.  S IBXPG=$O(^IBA(364.6,"ASEQ",IBXF,$P(PG,U)),-1)
  1.  F  S IBXPG=$O(^IBA(364.6,"ASEQ",IBXF,IBXPG)) Q:IBXPG=""!(IBXPG]$P(PG,U,2))  D
  1.  .S IBXLN=$O(^IBA(364.6,"ASEQ",IBXF,IBXPG,$P(LN,U)),-1) F  S IBXLN=$O(^IBA(364.6,"ASEQ",IBXF,IBXPG,IBXLN)) Q:IBXLN=""!(IBXLN]$P(LN,U,2))  D  G:$G(IBXERR)'="" PTQ
  1.  ..S IBXCOL="" F  S IBXCOL=$O(^IBA(364.6,"ASEQ",IBXF,IBXPG,IBXLN,IBXCOL)) Q:IBXCOL=""  D  Q:$G(IBXERR)'=""
  1.  ...S IBXDA=$O(^IBA(364.6,"ASEQ",IBXF,IBXPG,IBXLN,IBXCOL,""))
  1.  ...Q:'IBXDA
  1.  ...D DATA^IBCEFG(IBXPG,IBXLN,IBXCOL,IBXIEN,IBXFORM,IBXDA,.IBXPARM,.IBXERR)
  1.  S IBXPG="" F  S IBXPG=$O(^TMP("IBXDATA",$J,1,IBXPG)) Q:IBXPG=""!(IBXPG>$P(PG,U,2))  F IBXLN=+LN:1:$P(LN,U,2) S:$G(FORMAT) ^TMP("IBXDISP",$J,IBXPG,IBXLN)="" D
  1.  .Q:'$D(^TMP("IBXDATA",$J,1,IBXPG,IBXLN))
  1.  .S IBXCOL="" F  S IBXCOL=$O(^TMP("IBXDATA",$J,1,IBXPG,IBXLN,IBXCOL)) Q:IBXCOL=""  S Z=$G(^(IBXCOL)) I Z'="" D
  1.  ..I $G(FORMAT) S $E(^TMP("IBXDISP",$J,IBXPG,IBXLN),IBXCOL,IBXCOL+$L(Z)-1)=Z Q
  1.  ..I '$G(FORMAT) S ^TMP("IBXDISP",$J,IBXPG,IBXLN,IBXCOL)=Z
  1.  ;
  1. PTQ K ^TMP("IBXDATA",$J),^TMP("DIERR",$J)
  1.  Q
  1.  ;
  1. BILLN(FORMAT,PG,LN,IBXIEN,IBXFORM) ; Call to extract the contents of lines on a bill
  1.  ; See PARTEXT for parameters
  1.  ; RETURNS null if extract OK, OR error text if not
  1.  N IBXPARM,IBXERR,IBXDATA,IBXSIZE
  1.  K ^TMP("IBXSAVE",$J)
  1.  D BILLPARM(IBXIEN,.IBXPARM)
  1.  D PARTEXT(FORMAT,PG,LN,IBXIEN,IBXFORM,.IBXPARM,.IBXERR)
  1.  K ^TMP("IBXSAVE",$J)
  1.  Q $G(IBXERR)
  1.  ;
  1. EXTONE(IBXIEN,IBXELE,IBX,IBXERR) ;
  1.  ; Extract unformatted data element(s) for record in file whose entry
  1.  ;   is IBXIEN
  1.  ; IBXELE(1-n) = array passed by reference and containing the data
  1.  ;             element ien's from file 364.5 to return
  1.  ; IBX = name of array to be returned containing the data requested.
  1.  ;        For individual-valued elements, IBX(1-n) will
  1.  ;          contain the data element values.
  1.  ;        For group elements, IBX(1-n,1-z) will contain the
  1.  ;          values of the data element's 1-z occurrences.
  1.  ; 
  1.  ; IBXERR = if an error, the error message will be returned here
  1.  ;
  1.  N IBX00,IBXQ,IBXDATA,IBXFILE,IBXXD,Z0,Z1
  1.  K @IBX
  1.  S IBXQ="" F  S IBXQ=$O(IBXELE(IBXQ)) Q:'IBXQ  D
  1.  .S IBX00=$G(^IBA(364.5,+IBXELE(IBXQ),0)),IBXFILE=+$P(IBX00,U,5),IBXARRAY=$P($G(^IBA(364.5,+IBXELE(IBXQ),2)),U) S:IBXARRAY="" IBXARRAY="IBXDATA"
  1.  .Q:'IBXFILE
  1.  .K IBXXD
  1.  .S IBXXD=$$DATA(IBXELE(IBXQ),IBX00,IBXFILE,IBXIEN,IBXARRAY,.IBXERR)
  1.  .I $D(@IBXARRAY)=1 S (@IBX,@IBX@(IBXQ))=@IBXARRAY Q
  1.  .S Z0="",Z1=0 F  S Z0=$O(@IBXARRAY@(Z0)) Q:'Z0  S Z1=Z1+1 M @IBX@(IBXQ,Z1)=@IBXARRAY@(Z0)
  1.  Q
  1.  ;