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

IBTASDBUTL.m

Go to the documentation of this file. 
  1. IBTASDBUTL ;EDE/TPF - UTILITY APIS FOR VTU VISTA TABLE UTILITY 
  1.  ;;2.0;INTEGRATED BILLING;**742**;;Build 36
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1.  ;K POSTFDA,PUTFDA D CONVERTTOFDA^IBTASDBUTL(.ARG,.POSTFDA,.PUTFDA)
  1. CONVERTTOFDA(ARRAY,POSTFDA,PUTFDA,FDAERROR) ;EP -
  1.  N CHANGTYPE,FILENUM,FIELD,FIELDNUM,RECNUM,RECORDSEQ,SUBSCRIPT,VALUE
  1.  ;
  1.  ;ARRAY WILL BE A SIMPLE ONE SUBCRIPTED ARRAY. THE SUBSCRIPT IS A
  1.  ;'FUSION' OF THE FILENUMBER, 'RECORD NUMBER' AND FIELD NUMBER
  1.  ;THE RESULTANT PUTFDA AND ADDFDA IS A PSEUDO FDA ARRAY AND 
  1.  ;
  1.  S SUBSCRIPT=""
  1.  F RECNUM=1:1 S SUBSCRIPT=$O(ARRAY(SUBSCRIPT)) Q:SUBSCRIPT=""  D
  1.  .S FIELDNUM=$$LOW^XLFSTR($P(SUBSCRIPT,"_",3))
  1.  .I FIELDNUM="-changetype" S CHANGTYPE=$$UP^XLFSTR(ARRAY(SUBSCRIPT)) Q
  1.  .I FIELDNUM="-filenumber" Q
  1.  .S FILENUM=$P(SUBSCRIPT,"_")
  1.  .S RECORDSEQ=$P(SUBSCRIPT,"_",2)
  1.  .S VALUE=$G(ARRAY(SUBSCRIPT))
  1.  .I '$$ISFILE^IBTASDBUTL(FILENUM) D  Q
  1.  ..;
  1.  ..S FDAERROR("0^fda_errors",RECORDSEQ,"ARG array record")=$G(RECORDSEQ)
  1.  ..S VALUE=$S($G(VALUE)=+$G(VALUE):$G(VALUE),1:""""_$G(VALUE)_"""")
  1.  ..S FDAERROR("0^fda_errors",RECORDSEQ,".01")=$G(VALUE)
  1.  ..;S FILENUM=$S($G(FILENUM)=+$G(FILENUM):$G(FILENUM),1:""""_$G(FILENUM)_"""")
  1.  ..S FDAERROR("0^fda_errors",RECORDSEQ,"error_message")="File "_$G(FILENUM)_" does NOT exist! Cannot create FDA array"
  1.  .;
  1.  .;ADD API CHECK FOR VALID CHANGETYPE VALUES - SCREENED BY  TAS-api?
  1.  .I CHANGTYPE="A" S POSTFDA(FILENUM,RECORDSEQ,FIELDNUM)=VALUE Q
  1.  .I CHANGTYPE="M" S PUTFDA(FILENUM,RECORDSEQ,FIELDNUM)=VALUE Q
  1.  .;
  1.  .I SUBSCRIPT[(".01") D
  1.  ..S FDAERROR("0^fda_errors",RECORDSEQ,"ARG array record")=$G(RECORDSEQ)
  1.  ..S FDAERROR("0^fda_errors",RECORDSEQ,"-changetype")=""""_$G(CHANGTYPE)_""""
  1.  ..S FDAERROR("0^fda_errors",RECORDSEQ,".01")=$G(ARG(SUBSCRIPT))
  1.  ..S FDAERROR("0^fda_errors",RECORDSEQ,"error_message")="Unknown CHANGTYPE found in -changetype field. Cannot determine API call."
  1.  ;
  1.  Q
  1.  ;
  1. ISFILE(FILENUM) ;EP - DOES FILE EXIST?
  1.  Q $D(^DIC(FILENUM,0))
  1.  ;
  1. LKPFLAGS(FLAGS,FILENUM,ARGRECORD,TARGET,ARG,FINDRES) ;EP - ANALYZE FILE AND RETURN APPROPRIATE FLAGS AND TARGET
  1.  N FILEIEN,FIELDNUM,KEYSEQ,SUB
  1.  ;
  1.  I '$D(^DD("KEY","B",FILENUM)) D  Q  ;IF NO KEY UNIQUE INDEX THEN SIMPLELOOKUP ON STANDARD X-REFS?
  1.  .S FLAGS="MOX"
  1.  .S TARGET=$G(ARG(FILENUM,ARGRECORD,.01))
  1.  ;
  1.  ;CHECK KEY FILE
  1.  I $D(^DD("KEY","B",FILENUM)) D  Q
  1.  .S FLAGS="K"
  1.  .S FILEIEN=$O(^DD("KEY","B",FILENUM,""))
  1.  .S KEYSEQ=0
  1.  .F  S KEYSEQ=$O(^DD("KEY",FILEIEN,2,"S",KEYSEQ)) Q:'KEYSEQ  D
  1.  ..S FIELDNUM=$O(^DD("KEY",FILEIEN,2,"S",KEYSEQ,""))
  1.  ..S TARGET(KEYSEQ)=$G(ARG(FILENUM,ARGRECORD,FIELDNUM))
  1.  ..I TARGET(KEYSEQ)="" D
  1.  ...S FINDRES("0^find_error",ARGRECORD,"ARG array record")=$G(ARGRECORD)
  1.  ...S FINDRES("0^find_errors",ARGRECORD,KEYSEQ)=$G(FIELDNUM)
  1.  ...S FINDRES("0^find_errors",ARGRECORD,"error_message")="ARG record missing KEY unique index values needed."  ;DON'T NEED FM API WILL KNOW THIS, BUT THIS WILL REPORT FIELDS MISSING
  1.  Q