IBTASDBUTL ;EDE/TPF - UTILITY APIS FOR VTU VISTA TABLE UTILITY
;;2.0;INTEGRATED BILLING;**742**;;Build 36
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
;K POSTFDA,PUTFDA D CONVERTTOFDA^IBTASDBUTL(.ARG,.POSTFDA,.PUTFDA)
CONVERTTOFDA(ARRAY,POSTFDA,PUTFDA,FDAERROR) ;EP -
N CHANGTYPE,FILENUM,FIELD,FIELDNUM,RECNUM,RECORDSEQ,SUBSCRIPT,VALUE
;
;ARRAY WILL BE A SIMPLE ONE SUBCRIPTED ARRAY. THE SUBSCRIPT IS A
;'FUSION' OF THE FILENUMBER, 'RECORD NUMBER' AND FIELD NUMBER
;THE RESULTANT PUTFDA AND ADDFDA IS A PSEUDO FDA ARRAY AND
;
S SUBSCRIPT=""
F RECNUM=1:1 S SUBSCRIPT=$O(ARRAY(SUBSCRIPT)) Q:SUBSCRIPT="" D
.S FIELDNUM=$$LOW^XLFSTR($P(SUBSCRIPT,"_",3))
.I FIELDNUM="-changetype" S CHANGTYPE=$$UP^XLFSTR(ARRAY(SUBSCRIPT)) Q
.I FIELDNUM="-filenumber" Q
.S FILENUM=$P(SUBSCRIPT,"_")
.S RECORDSEQ=$P(SUBSCRIPT,"_",2)
.S VALUE=$G(ARRAY(SUBSCRIPT))
.I '$$ISFILE^IBTASDBUTL(FILENUM) D Q
..;
..S FDAERROR("0^fda_errors",RECORDSEQ,"ARG array record")=$G(RECORDSEQ)
..S VALUE=$S($G(VALUE)=+$G(VALUE):$G(VALUE),1:""""_$G(VALUE)_"""")
..S FDAERROR("0^fda_errors",RECORDSEQ,".01")=$G(VALUE)
..;S FILENUM=$S($G(FILENUM)=+$G(FILENUM):$G(FILENUM),1:""""_$G(FILENUM)_"""")
..S FDAERROR("0^fda_errors",RECORDSEQ,"error_message")="File "_$G(FILENUM)_" does NOT exist! Cannot create FDA array"
.;
.;ADD API CHECK FOR VALID CHANGETYPE VALUES - SCREENED BY TAS-api?
.I CHANGTYPE="A" S POSTFDA(FILENUM,RECORDSEQ,FIELDNUM)=VALUE Q
.I CHANGTYPE="M" S PUTFDA(FILENUM,RECORDSEQ,FIELDNUM)=VALUE Q
.;
.I SUBSCRIPT[(".01") D
..S FDAERROR("0^fda_errors",RECORDSEQ,"ARG array record")=$G(RECORDSEQ)
..S FDAERROR("0^fda_errors",RECORDSEQ,"-changetype")=""""_$G(CHANGTYPE)_""""
..S FDAERROR("0^fda_errors",RECORDSEQ,".01")=$G(ARG(SUBSCRIPT))
..S FDAERROR("0^fda_errors",RECORDSEQ,"error_message")="Unknown CHANGTYPE found in -changetype field. Cannot determine API call."
;
Q
;
ISFILE(FILENUM) ;EP - DOES FILE EXIST?
Q $D(^DIC(FILENUM,0))
;
LKPFLAGS(FLAGS,FILENUM,ARGRECORD,TARGET,ARG,FINDRES) ;EP - ANALYZE FILE AND RETURN APPROPRIATE FLAGS AND TARGET
N FILEIEN,FIELDNUM,KEYSEQ,SUB
;
I '$D(^DD("KEY","B",FILENUM)) D Q ;IF NO KEY UNIQUE INDEX THEN SIMPLELOOKUP ON STANDARD X-REFS?
.S FLAGS="MOX"
.S TARGET=$G(ARG(FILENUM,ARGRECORD,.01))
;
;CHECK KEY FILE
I $D(^DD("KEY","B",FILENUM)) D Q
.S FLAGS="K"
.S FILEIEN=$O(^DD("KEY","B",FILENUM,""))
.S KEYSEQ=0
.F S KEYSEQ=$O(^DD("KEY",FILEIEN,2,"S",KEYSEQ)) Q:'KEYSEQ D
..S FIELDNUM=$O(^DD("KEY",FILEIEN,2,"S",KEYSEQ,""))
..S TARGET(KEYSEQ)=$G(ARG(FILENUM,ARGRECORD,FIELDNUM))
..I TARGET(KEYSEQ)="" D
...S FINDRES("0^find_error",ARGRECORD,"ARG array record")=$G(ARGRECORD)
...S FINDRES("0^find_errors",ARGRECORD,KEYSEQ)=$G(FIELDNUM)
...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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTASDBUTL 2982 printed Apr 09, 2024@21:04:31 Page 2
IBTASDBUTL ;EDE/TPF - UTILITY APIS FOR VTU VISTA TABLE UTILITY
+1 ;;2.0;INTEGRATED BILLING;**742**;;Build 36
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ;K POSTFDA,PUTFDA D CONVERTTOFDA^IBTASDBUTL(.ARG,.POSTFDA,.PUTFDA)
CONVERTTOFDA(ARRAY,POSTFDA,PUTFDA,FDAERROR) ;EP -
+1 NEW CHANGTYPE,FILENUM,FIELD,FIELDNUM,RECNUM,RECORDSEQ,SUBSCRIPT,VALUE
+2 ;
+3 ;ARRAY WILL BE A SIMPLE ONE SUBCRIPTED ARRAY. THE SUBSCRIPT IS A
+4 ;'FUSION' OF THE FILENUMBER, 'RECORD NUMBER' AND FIELD NUMBER
+5 ;THE RESULTANT PUTFDA AND ADDFDA IS A PSEUDO FDA ARRAY AND
+6 ;
+7 SET SUBSCRIPT=""
+8 FOR RECNUM=1:1
SET SUBSCRIPT=$ORDER(ARRAY(SUBSCRIPT))
if SUBSCRIPT=""
QUIT
Begin DoDot:1
+9 SET FIELDNUM=$$LOW^XLFSTR($PIECE(SUBSCRIPT,"_",3))
+10 IF FIELDNUM="-changetype"
SET CHANGTYPE=$$UP^XLFSTR(ARRAY(SUBSCRIPT))
QUIT
+11 IF FIELDNUM="-filenumber"
QUIT
+12 SET FILENUM=$PIECE(SUBSCRIPT,"_")
+13 SET RECORDSEQ=$PIECE(SUBSCRIPT,"_",2)
+14 SET VALUE=$GET(ARRAY(SUBSCRIPT))
+15 IF '$$ISFILE^IBTASDBUTL(FILENUM)
Begin DoDot:2
+16 ;
+17 SET FDAERROR("0^fda_errors",RECORDSEQ,"ARG array record")=$GET(RECORDSEQ)
+18 SET VALUE=$SELECT($GET(VALUE)=+$GET(VALUE):$GET(VALUE),1:""""_$GET(VALUE)_"""")
+19 SET FDAERROR("0^fda_errors",RECORDSEQ,".01")=$GET(VALUE)
+20 ;S FILENUM=$S($G(FILENUM)=+$G(FILENUM):$G(FILENUM),1:""""_$G(FILENUM)_"""")
+21 SET FDAERROR("0^fda_errors",RECORDSEQ,"error_message")="File "_$GET(FILENUM)_" does NOT exist! Cannot create FDA array"
End DoDot:2
QUIT
+22 ;
+23 ;ADD API CHECK FOR VALID CHANGETYPE VALUES - SCREENED BY TAS-api?
+24 IF CHANGTYPE="A"
SET POSTFDA(FILENUM,RECORDSEQ,FIELDNUM)=VALUE
QUIT
+25 IF CHANGTYPE="M"
SET PUTFDA(FILENUM,RECORDSEQ,FIELDNUM)=VALUE
QUIT
+26 ;
+27 IF SUBSCRIPT[(".01")
Begin DoDot:2
+28 SET FDAERROR("0^fda_errors",RECORDSEQ,"ARG array record")=$GET(RECORDSEQ)
+29 SET FDAERROR("0^fda_errors",RECORDSEQ,"-changetype")=""""_$GET(CHANGTYPE)_""""
+30 SET FDAERROR("0^fda_errors",RECORDSEQ,".01")=$GET(ARG(SUBSCRIPT))
+31 SET FDAERROR("0^fda_errors",RECORDSEQ,"error_message")="Unknown CHANGTYPE found in -changetype field. Cannot determine API call."
End DoDot:2
End DoDot:1
+32 ;
+33 QUIT
+34 ;
ISFILE(FILENUM) ;EP - DOES FILE EXIST?
+1 QUIT $DATA(^DIC(FILENUM,0))
+2 ;
LKPFLAGS(FLAGS,FILENUM,ARGRECORD,TARGET,ARG,FINDRES) ;EP - ANALYZE FILE AND RETURN APPROPRIATE FLAGS AND TARGET
+1 NEW FILEIEN,FIELDNUM,KEYSEQ,SUB
+2 ;
+3 ;IF NO KEY UNIQUE INDEX THEN SIMPLELOOKUP ON STANDARD X-REFS?
IF '$DATA(^DD("KEY","B",FILENUM))
Begin DoDot:1
+4 SET FLAGS="MOX"
+5 SET TARGET=$GET(ARG(FILENUM,ARGRECORD,.01))
End DoDot:1
QUIT
+6 ;
+7 ;CHECK KEY FILE
+8 IF $DATA(^DD("KEY","B",FILENUM))
Begin DoDot:1
+9 SET FLAGS="K"
+10 SET FILEIEN=$ORDER(^DD("KEY","B",FILENUM,""))
+11 SET KEYSEQ=0
+12 FOR
SET KEYSEQ=$ORDER(^DD("KEY",FILEIEN,2,"S",KEYSEQ))
if 'KEYSEQ
QUIT
Begin DoDot:2
+13 SET FIELDNUM=$ORDER(^DD("KEY",FILEIEN,2,"S",KEYSEQ,""))
+14 SET TARGET(KEYSEQ)=$GET(ARG(FILENUM,ARGRECORD,FIELDNUM))
+15 IF TARGET(KEYSEQ)=""
Begin DoDot:3
+16 SET FINDRES("0^find_error",ARGRECORD,"ARG array record")=$GET(ARGRECORD)
+17 SET FINDRES("0^find_errors",ARGRECORD,KEYSEQ)=$GET(FIELDNUM)
+18 ;DON'T NEED FM API WILL KNOW THIS, BUT THIS WILL REPORT FIELDS MISSING
SET FINDRES("0^find_errors",ARGRECORD,"error_message")="ARG record missing KEY unique index values needed."
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+19 QUIT
