FBUTL135 ;DSS/LJF - FEE BASIS UTILITY FOR UNIQUE CLAIM ID - FEE5010 ;3/23/2012
;;3.5;FEE BASIS;**135,166**;JAN 30, 1995;Build 7
;;Per VA Directive 6402, this routine should not be modified.
;
Q
UCLAIMNO(FBSTA,FBSRC,FBINT,FBCLT,FBCLAIMS) ; Unique Claim Identifier for patch 135
N FBFDA,FBHELD,FBYEAR,FBINTDF,FBCLTDF,FBSRCDF,FBSTADF
; Input: FBSTA = Station
; FBSRC = Source
; FBINT = Initiation Type
; FBCLT = Claim Type
; FBCLAIMS = FPPS CLAIM ID - replaces sequence number
; Output: 21 character string composed of the following characters:
; 1-5 5 Character Station ID - left justified with trailing Zero's
; 6 1 Character Source - 1=Fee, 2=FBCS, 3=VAPM, 4-9 - Future Use, default is 1
; 7 1 character Initiation Type - (S)canned, (E)DI, (M)anual ; default is M
; 8 1 Character Claim Type - (I)nstitutional, (P)rofessional, (D)ental, (N)on-Standard ; default is N
; 9-12 4 digit year
; 13 1 character "-"
; 14-28 15 character SEQUENCE NUMBER unique to the year - reinitialized when year changes
; or: the number supplied in FBCLAIMS - NOTE: this value will be limited to 15 digits
; UCID example without FBCLAIMS supplied : 500001MN2012-291
;
S FBSRCDF="1",FBINTDF="M",FBCLTDF="N",FBCLAIMS=$G(FBCLAIMS) ; Defaults
S FBSTA=$E($S($G(FBSTA)]"":FBSTA,1:$$STATION)_"00000",1,5) ; Station
; Get first non space character for each input string;
S FBSRC=$E($S(+$G(FBSRC):+FBSRC,1:FBSRCDF),1) ; Source
S FBINT=$E($TR($G(FBINT,FBINTDF)," ")),FBINT=$S(FBINT="":FBINTDF,"SEM"[FBINT:FBINT,1:FBINTDF) ; Initiation Type
S FBCLT=$E($TR($G(FBCLT,FBCLTDF)," ")),FBCLT=$S(FBCLT="":FBCLTDF,"IPDN"[FBCLT:FBCLT,1:FBCLTDF) ; Claim Type
I FBCLAIMS="" S FBCLAIMS=$$CLAIMNO ; Generate Claim number if needed
Q (FBSTA_FBSRC_FBINT_FBCLT_$E(FBCLAIMS,1,20))
;
CLAIMNO() ; Return the value of field 39: UNIQUE CLAIM IDENTIFIER SEQ from file 161.4: FEE BASIS SITE PARAMETERS - incremented by one
N FBCLAIMS,FBYEAR
S FBCLAIMS=$E($TR($$NOW^XLFDT,".")_"000000000",1,15) ;default if can't lock global
; Lock the global node and set sequence number
F FBHELD=1:1:10 L +^FBAA(161.4,1,2):$G(DILOCTM,3) I D L -^FBAA(161.4,1,2) Q
. S FBCLAIMS=$$GET1^DIQ(161.4,1,39,"I"),FBYEAR=+$P($$HTE^XLFDT($H)," ",3)
. I FBYEAR'=$P(FBCLAIMS,"-") S FBCLAIMS="-0" ;reinit sequence when year changes
. S FBCLAIMS=FBYEAR_"-"_(1+$P(FBCLAIMS,"-",2))
. S FBFDA(161.4,"1,",39)=FBCLAIMS D FILE^DIE(,"FBFDA") ; increment and file
Q FBCLAIMS
;
VALIDATE(TYPE,UCID) ;
N VALID,FBSTA,FBSRC,FBINT,FBCLMT
S VALID=0
I TYPE="I" D Q VALID
. I $L(UCID)<14 Q ; needs to be at least 14 characters long
. S FBSTA=$E(UCID,1,5)
. S FBSRC=$E(UCID,6)
. S FBINT=$E(UCID,7)
. S FBCLMT=$E(UCID,8)
. S $E(UCID,1,8)=""
. I FBSRC,"SEM"[FBINT,FBCLMT="I",UCID?4N1"-"1.15N S VALID=1
I TYPE="O" D Q VALID
. I $L(UCID)<14 Q ; needs to be at least 14 characters long
. S FBSTA=$E(UCID,1,5)
. S FBSRC=$E(UCID,6)
. S FBINT=$E(UCID,7)
. S FBCLMT=$E(UCID,8)
. S $E(UCID,1,8)=""
. I FBSRC,"SEM"[FBINT,"PDN"[FBCLMT,UCID?4N1"-"1.15N S VALID=1
Q VALID
;
STATION() ; Set station
N FBAASN,FBPOP,FBSITE,FBSN,FB
D STATION^FBAAUTL S FBSN=$E(FBSN_"00000",1,5)
Q FBSN
;
INVUCID(FBAAIN,FBSTA,FBSRC,FBINTYP,FBCLAIMS) ; populates file 162.5 field UCID and returns UCID
N UCID,FBDAT,FBMSG,FBCLTYP
;FBAAIN = IEN of entry in file 162.5
;FBSTA = Station ID
;FBSRC = Source - 1=Fee, 2=FBCS, 3=VAPM, 4-9 - Future Use
;FBINTYP = Initiation Type - (S)canned, (E)DI, (M)anual
;FBCLAIMS = Claim Number in format YYYY-nnnn format
;
S UCID="-1",FBCLTYP="I" ;- Claim Type is always - 'I'nstitution - for this API
I $G(FBAAIN),$G(FBSTA)]"",$G(FBSRC)]"",$G(FBINTYP)]"",$G(FBCLAIMS)]"" ; Validate all input parameters populated
E D Q UCID
. S:'$G(FBAAIN) UCID=UCID_U_"UNDEFINED INVOICE IEN" S:$G(FBSTA)="" UCID=UCID_U_"UNDEFINED STATION"
. S:$G(FBSRC)="" UCID=UCID_U_"UNDEFINED SOURCE" S:$G(FBINTYP)="" UCID=UCID_U_"UNDEFINED INITIATION TYPE"
. S:$G(FBCLAIMS)="" UCID=UCID_U_"UNDEFINED CLAIM NUMBER"
; Validate paramaters contain acceptable values
I $L(FBSTA)<3 S UCID=UCID_U_"INVALID STATION PARAMETER"
I FBSRC,FBSRC?1N
E S UCID=UCID_U_"INVALID SOURCE PARAMETER"
I "SEM"[FBINTYP,$L(FBINTYP)=1
E S UCID=UCID_U_"INVALID INITIATION TYPE PARAMETER"
I FBCLAIMS'?4N1"-"1.15N S UCID=UCID_U_"INVALID CLAIM NUMBER PARAMETER"
I '$D(^FBAAI(FBAAIN)) S UCID=UCID_U_"INVALID ENTRY IN FILE 162.5: "_$NA(^FBAAI(FBAAIN))
I $L(UCID)>2 Q UCID
; parameters passed muster
S UCID=$$UCLAIMNO(FBSTA,FBSRC,FBINTYP,FBCLTYP,FBCLAIMS)
S FBDAT(162.5,FBAAIN_",",85)=UCID
D FILE^DIE(,"FBDAT","FBMSG")
I $D(FBMSG("DIERR")) S UCID="-1^"_"DIERR TEXT: "_$G(FBMSG("DIERR","1","TEXT",1))_$NA(^FBAAI(FBAAIN))_"^UCID: "_UCID
Q UCID
;
PAYUCID(DFN,FBV,FBSDI,FBAACPI,FBSTA,FBSRC,FBINTYP,FBCLTYP,FBCLAIMS) ;populates file 162 field UCID and returns UCID - Outpatient
N C,UCID,FBDAT,FBMSG
;DFN = IEN of PATIENT in 162
;FBV = IEN of VENDOR in 162
;FBSDI = IEN of INITIAL TREATMENT DATE multiple in 162
;FBAACPI = IEN of SERVICE PROVIDED multiple in 162
;FBSTA = Station ID
;FBSRC = Source - 1=Fee, 2=FBCS, 3=VAPM, 4-9 - Future Use
;FBINTYP = Initiation Type - (S)canned, (E)DI, (M)anual
;FBCLTYP = Claim Type - (I)nstitutional, (P)rofessional, (D)ental, (N)on-Standard
;FBCLAIMS = Claim Number in format YYYY-nnnn format
;
S C=",",UCID="-1"
I $G(DFN),$G(FBV),$G(FBSDI),$G(FBAACPI),$G(FBSTA)]"",$G(FBSRC),$G(FBINTYP)]"",$G(FBCLTYP)]"",$G(FBCLAIMS)]"" ; Validate all input parameters populated
E D Q UCID
. S:'$G(DFN) UCID=UCID_U_"UNDEFINED IEN of PATIENT" S:'$G(FBV) UCID=UCID_U_"UNDEFINED IEN of VENDOR"
. S:'$G(FBSDI) UCID=UCID_U_"UNDEFINED IEN of INITIAL TREATMENT DATE" S:'$G(FBAACPI) UCID=UCID_U_"UNDEFINED IEN of SERVICE PROVIDED"
. S:$G(FBSTA)="" UCID=UCID_U_"UNDEFINED STATION" S:'$G(FBSRC) UCID=UCID_U_"UNDEFINED SOURCE VALUE"
. S:$G(FBINTYP)="" UCID=UCID_U_"UNDEFINED INITIATION TYPE" S:$G(FBCLTYP)="" UCID=UCID_U_"UNDEFINED CLAIM TYPE"
. S:$G(FBCLAIMS)="" UCID=UCID_U_"UNDEFINED CLAIM NUMBER"
; Validate paramaters contain acceptable values
I $L(FBSTA)<3 S UCID=UCID_U_"INVALID STATION PARAMETER"
I FBSRC,FBSRC?1N
E S UCID=UCID_U_"INVALID SOURCE PARAMETER"
I "SEM"[FBINTYP,$L(FBINTYP)=1
E S UCID=UCID_U_"INVALID INITIATION TYPE PARAMETER"
I "PDN"[FBCLTYP,$L(FBCLTYP)=1
E S UCID=UCID_U_"INVALID CLAIM TYPE PARAMETER"
I FBCLAIMS'?4N1"-"1.15NUL S UCID=UCID_U_"INVALID CLAIM NUMBER PARAMETER"
I '$D(^FBAAC(DFN,1,FBV,1,FBSDI,1,FBAACPI)) S UCID=UCID_U_"INVALID ENTRY IN FILE 162: "_$NA(^FBAAC(DFN,1,FBV,1,FBSDI,1,FBAACPI))
I $L(UCID)>2 Q UCID
; parameters passed muster
S UCID=$$UCLAIMNO(FBSTA,FBSRC,FBINTYP,FBCLTYP,FBCLAIMS)
S FBDAT(162.03,FBAACPI_C_FBSDI_C_FBV_C_DFN_C,81)=UCID
D FILE^DIE(,"FBDAT","FBMSG")
I $D(FBMSG("DIERR")) S UCID="-1^"_"DIERR TEXT: "_$G(FBMSG("DIERR","1","TEXT",1))_$NA(^FBAAC(DFN,1,FBV,1,FBSDI,1,FBAACPI))_"^UCID: "_UCID
Q UCID
;
OCLMTYP(FBCURVAL) ; Get Outpatient Claim Type from the user
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DTOCNT
S FBCURVAL=$G(FBCURVAL) I $G(FBCURVAL)]"","PDN"[FBCURVAL S DIR("B")=FBCURVAL
S DIR(0)="SO^P:P;D:D;N:N"
S DIR("L",1)="Select the Claim Type:"
S DIR("L",2)=""
S DIR("L")=" P - Professional, D - Dental, N - Non-Standard"
S DTOCNT=0
F D ^DIR D Q:Y]""
. I $G(DTOUT) S Y=$S(FBCURVAL]"":FBCURVAL,1:"N") Q ; time out - set to "N"on-standard if no current value exists
. I Y="" W !!,"This is a required response." Q
. I Y="^" S Y="" W !!,"This is a required response. '^' is not allowed." K DUOUT Q
. I Y="^^" S Y="" W !!,"This is a required response. '^' is not allowed." K DUOUT Q
. I Y]"","PDN"[Y Q
. S Y="" W !,"Enter a code from the list."
Q Y
;
UCIDUTL() ;EP for TEST report to validate UCID information for FB PATCH 135
;
N DIR,FBQUIT,Y,FBSTG1,FBSRVC,FBPROG,FBID,DA,DUOUT,DIRUT,DTOUT,FBDONE
;
S FBQUIT=0
S FBDONE=0
;
I $G(DUZ(2))="" D
.W !,"DUZ NOT IDENTIFIED - PLEASE LOG IN BEFORE USING FB 135 TESTING UTILTIES"
.S FBDONE=1
;
D CLEAR()
W !,?5,"FEE BASIS PATCH 135 UNIQUE CLAIM IDENTIFIER DISPLAY"
F Q:FBDONE D
.S DIR("A",1)="Select the UCID REPORT or the PROGRAM you are testing"
.S DIR("A",2)="ENTER '^' or leave blank to EXIT"
.S DIR("A")="SELECT"
.S DIR(0)="SO^1:Outpatient and Inpatient UCID Display by Date Range Report"
.S DIR(0)=DIR(0)_";3:Outpatient UCID Screen Display"
.S DIR(0)=DIR(0)_";9:Inpatient UCID Screen Display"
.S DIR("B")=""
.D ^DIR
.K DIR("A")
.I $D(DUOUT) S FBDONE=1 ;DEFINED IF USER ENTERS ONE UP ARROW
.I $D(DIRUT) S FBDONE=1 ;DEFINED IF USER ENTERS TWO UP ARROWS
.I $D(DTOUT) S FBDONE=1 ;DEFINED IF USER TIMES OUT
.I '+Y S FBDONE=1
.Q:FBDONE
.S FBPROG=+Y
.I FBPROG=1 D UCIDRPT()
.I FBPROG=9 D ;INPATIENT
..S FBQUIT=0
..F Q:FBQUIT D
...S DIC=162.5 ;162.5 -- FEE BASIS INVOICE FILE
...S DIC(0)="AE"
...;S DIC("S")="I $P(^(0),U,9)="""""
...D ^DIC
...I $D(DUOUT) S FBQUIT=1
...I $D(DIRUT) S FBQUIT=1
...I $D(DTOUT) S FBQUIT=1
...I Y<0 S FBQUIT=1
...Q:FBQUIT
...I (Y>0) D
....;W !,"UCID: "_$P($G(^FBAAI(+Y,5)),U,5)
....S FBIEN=$P(Y,U,2)
....S FBNODE=^FBAAI(FBIEN,0)
....S FBDATE=$P(FBNODE,U,2)
....S FBVET=$P(FBNODE,U,4) ;POINTER TO 161 - FEE BASIS PATIENT
....S FBPAT=$P(^FBAAA(FBVET,0),U,1) ;POINTER TO FILE 2 - PATIENT
....S FBVNDR=$P(FBNODE,U,3) ;POINTER TO FB VENDOR FILE
....S Y=FBDATE
....D DD^%DT
....W !,$P(^DPT(FBPAT,0),U,1)_" "_$P(^FBAAV(FBVNDR,0),U,1)_" "_Y
....W !?10,"UCID: "_$P($G(^FBAAI(FBIEN,5)),U,5)
....H:('FBDONE)&('FBQUIT) 3
...W !!
.I FBPROG=3 D ;OUTPATIENT
..S FBQUIT=0
..F Q:FBQUIT D
...S DIC="^FBAAC(" ; 162 -- FEE BASIS PAYMENT FILE
...S DIC(0)="AE" ;
...D ^DIC ;PATIENT SELECTION
...I $D(DUOUT) S FBQUIT=1
...I $D(DIRUT) S FBQUIT=1
...I $D(DTOUT) S FBQUIT=1
...Q:FBQUIT
...S DA(1)=+Y
...Q:'+$O(^FBAAC(DA(1),1,0))
...S DIC="^FBAAC("_DA(1)_",1,"
...D ^DIC
...I $D(DUOUT) S FBQUIT=1
...I $D(DIRUT) S FBQUIT=1
...I $D(DTOUT) S FBQUIT=1
...Q:FBQUIT
...I +Y<0 W !,"No Fee Basis Invoice Vendors found for this patient!" Q
...S DA(2)=DA(1)
...S DA(1)=+Y
...Q:'+$O(^FBAAC(DA(2),1,DA(1),1,0))
...S DIC="^FBAAC("_DA(2)_",1,"_DA(1)_",1," ;INITIAL TREATMENT DATE SELECTION
...D ^DIC
...I $D(DUOUT) S FBQUIT=1
...I $D(DIRUT) S FBQUIT=1
...I $D(DTOUT) S FBQUIT=1
...Q:FBQUIT
...I +Y<0 W !,"No Fee Basis Invoice DATE OF SERVICE found for this Vendor!" Q
...S DA(3)=DA(2)
...S DA(2)=DA(1)
...S DA(1)=+Y
...Q:'+$O(^FBAAC(DA(3),1,DA(2),1,DA(1),1,0))
...S FBSRVC=0
...F S FBSRVC=$O(^FBAAC(DA(3),1,DA(2),1,DA(1),1,FBSRVC)) Q:'+FBSRVC D
....S FBPNTR=$P($G(^FBAAC(DA(3),1,DA(2),1,DA(1),1,FBSRVC,0)),U,1) ;POINTER TO 81 - CPT FILE
....W !,"SERVICE: ",$P($$CPT^ICPTCOD(FBPNTR),U,2)," ",$P($$CPT^ICPTCOD(FBPNTR),U,3),?50,"UCID: "_$P($G(^FBAAC(DA(3),1,DA(2),1,DA(1),1,FBSRVC,5)),U,5) ;FB*3.5*166 - Update direct global reads of 81 file to API
...H:('FBDONE)&('FBQUIT) 3
...W !!
.D CLEAR()
Q
CLEAR() ;CLEAR SCREEN
N FBLINE
F FBLINE=1:1:10 W !
Q
UCIDRPT() ;PROVIDES A REPORT OF ALL UCIDS IN THE SYSTEM FOR A DATE RANGE
;
N DIR,FBQUIT,FBSTRT,FBEND,Y,FBSDATE,FBEDATE,FBDATE,FBINTLDT,FBPAT
S FBQUIT=0
S Y=DT
D DD^%DT
S FBTODAY=Y
S DIR("A")="Enter the START DATE for UCID report"
S DIR(0)="D"
S DIR("B")=FBTODAY
D ^DIR
I $D(DUOUT) S FBQUIT=1
I $D(DIRUT) S FBQUIT=1
I $D(DTOUT) S FBQUIT=1
S FBSTRT=Y
I 'FBQUIT D
.S DIR("A")="Enter the END DATE for UCID report"
.S DIR(0)="D"
.S DIR("B")=FBTODAY
.D ^DIR
.I $D(DUOUT) S FBQUIT=1
.I $D(DIRUT) S FBQUIT=1
.I $D(DTOUT) S FBQUIT=1
.S FBEND=Y
I 'FBQUIT D
.D ^%ZIS
.I 'POP D
..U IO
..S Y=FBSTRT
..D DD^%DT
..S FBSDATE=Y
..S Y=FBEND
..D DD^%DT
..S FBEDATE=Y
..W !,"OUTPATIENT INVOICES INITIAL SERVICES FROM: ",FBSDATE," TO: "_FBEDATE
..D OUTDSPLY(FBSTRT,FBEND)
..W !!,"CIVIL HOSPITAL INVOICES DATE RECEIVED FROM: ",FBSDATE," TO: "_FBEDATE
..D INDSPLY(FBSTRT,FBEND)
.D ^%ZISC
Q
OUTDSPLY(FBSTRT,FBEND) ;DISPLAY OUTPATIENT UCID INFORMATION FOR A DATE RANGE
; INPUT : FBSTRT : A FM DATE REPRESENTING THE STARTING DATE FOR REPORT
; FBEND : A FM DATE REPRESENTING THE ENDING DATE FOR REPORT
;
N FBIEN,FBVNDR,FBINTLDT,FBSRVC,FBSNUM
S FBIEN=0
F S FBIEN=$O(^FBAAC(FBIEN)) Q:'+FBIEN D
.S FBVNDR=0
.F S FBVNDR=$O(^FBAAC(FBIEN,1,FBVNDR)) Q:'+FBVNDR D
..S FBINTLDT=0
..F S FBINTLDT=$O(^FBAAC(FBIEN,1,FBVNDR,1,FBINTLDT)) Q:'+FBINTLDT D
...S FBDATE=$P(^FBAAC(FBIEN,1,FBVNDR,1,FBINTLDT,0),U,1)
...I (FBSTRT<=FBDATE)&(FBDATE<=FBEND) D
....W !
....;NOW PRINT OUT PATIENT NAME, VENDOR NAME, TREATMENT DATE, AND EACH SERVICE AND UCID
....S Y=FBDATE
....D DD^%DT
....W !,$P(^DPT(FBIEN,0),U,1)_" "_$P(^FBAAV(FBVNDR,0),U,1)_" "_Y
....S FBSNUM=0
....F S FBSNUM=$O(^FBAAC(FBIEN,1,FBVNDR,1,FBINTLDT,1,FBSNUM)) Q:'+FBSNUM D
.....S FBSRVC=$P(^FBAAC(FBIEN,1,FBVNDR,1,FBINTLDT,1,FBSNUM,0),U,1)
.....W !,"SERVICE: ",$P($$CPT^ICPTCOD(FBSRVC),U,2)," ",$P($$CPT^ICPTCOD(FBSRVC),U,3),?50,"UCID: "_$P($G(^FBAAC(FBIEN,1,FBVNDR,1,FBINTLDT,1,FBSNUM,5)),U,5) ;FB*3.5*166 - Update direct global reads of 81 file to API
Q
;
INDSPLY(FBSTRT,FBEND) ;DISPLAY CIVIL HOSPITAL UCID INFORMATION FOR A DATE RANGE
; INPUT : FBSTRT : A FM DATE REPRESENTING THE STARTING DATE FOR REPORT
; FBEND : A FM DATE REPRESENTING THE ENDING DATE FOR REPORT
N FBIEN,DBDATE,FBVET,FBPAT,FBVNDR
S FBIEN=0
F S FBIEN=$O(^FBAAI(FBIEN)) Q:'+FBIEN D
.S FBNODE=^FBAAI(FBIEN,0)
.S FBDATE=$P(FBNODE,U,2)
.I (FBSTRT<=FBDATE)&(FBDATE<=FBEND) D
..W !
..S FBVET=$P(FBNODE,U,4) ;POINTER TO 161
..S FBPAT=$P(^FBAAA(FBVET,0),U,1) ;POINTER TO FILE 2
..S FBVNDR=$P(FBNODE,U,3)
..S Y=FBDATE
..D DD^%DT
..W !,$P(FBNODE,U,1)_" "_$P(^DPT(FBPAT,0),U,1)_" "_$P(^FBAAV(FBVNDR,0),U,1)_" "_Y
..W !?10,"UCID: "_$P($G(^FBAAI(FBIEN,5)),U,5)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUTL135 14176 printed Sep 23, 2025@19:36:47 Page 2
FBUTL135 ;DSS/LJF - FEE BASIS UTILITY FOR UNIQUE CLAIM ID - FEE5010 ;3/23/2012
+1 ;;3.5;FEE BASIS;**135,166**;JAN 30, 1995;Build 7
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
UCLAIMNO(FBSTA,FBSRC,FBINT,FBCLT,FBCLAIMS) ; Unique Claim Identifier for patch 135
+1 NEW FBFDA,FBHELD,FBYEAR,FBINTDF,FBCLTDF,FBSRCDF,FBSTADF
+2 ; Input: FBSTA = Station
+3 ; FBSRC = Source
+4 ; FBINT = Initiation Type
+5 ; FBCLT = Claim Type
+6 ; FBCLAIMS = FPPS CLAIM ID - replaces sequence number
+7 ; Output: 21 character string composed of the following characters:
+8 ; 1-5 5 Character Station ID - left justified with trailing Zero's
+9 ; 6 1 Character Source - 1=Fee, 2=FBCS, 3=VAPM, 4-9 - Future Use, default is 1
+10 ; 7 1 character Initiation Type - (S)canned, (E)DI, (M)anual ; default is M
+11 ; 8 1 Character Claim Type - (I)nstitutional, (P)rofessional, (D)ental, (N)on-Standard ; default is N
+12 ; 9-12 4 digit year
+13 ; 13 1 character "-"
+14 ; 14-28 15 character SEQUENCE NUMBER unique to the year - reinitialized when year changes
+15 ; or: the number supplied in FBCLAIMS - NOTE: this value will be limited to 15 digits
+16 ; UCID example without FBCLAIMS supplied : 500001MN2012-291
+17 ;
+18 ; Defaults
SET FBSRCDF="1"
SET FBINTDF="M"
SET FBCLTDF="N"
SET FBCLAIMS=$GET(FBCLAIMS)
+19 ; Station
SET FBSTA=$EXTRACT($SELECT($GET(FBSTA)]"":FBSTA,1:$$STATION)_"00000",1,5)
+20 ; Get first non space character for each input string;
+21 ; Source
SET FBSRC=$EXTRACT($SELECT(+$GET(FBSRC):+FBSRC,1:FBSRCDF),1)
+22 ; Initiation Type
SET FBINT=$EXTRACT($TRANSLATE($GET(FBINT,FBINTDF)," "))
SET FBINT=$SELECT(FBINT="":FBINTDF,"SEM"[FBINT:FBINT,1:FBINTDF)
+23 ; Claim Type
SET FBCLT=$EXTRACT($TRANSLATE($GET(FBCLT,FBCLTDF)," "))
SET FBCLT=$SELECT(FBCLT="":FBCLTDF,"IPDN"[FBCLT:FBCLT,1:FBCLTDF)
+24 ; Generate Claim number if needed
IF FBCLAIMS=""
SET FBCLAIMS=$$CLAIMNO
+25 QUIT (FBSTA_FBSRC_FBINT_FBCLT_$EXTRACT(FBCLAIMS,1,20))
+26 ;
CLAIMNO() ; Return the value of field 39: UNIQUE CLAIM IDENTIFIER SEQ from file 161.4: FEE BASIS SITE PARAMETERS - incremented by one
+1 NEW FBCLAIMS,FBYEAR
+2 ;default if can't lock global
SET FBCLAIMS=$EXTRACT($TRANSLATE($$NOW^XLFDT,".")_"000000000",1,15)
+3 ; Lock the global node and set sequence number
+4 FOR FBHELD=1:1:10
LOCK +^FBAA(161.4,1,2):$GET(DILOCTM,3)
IF $TEST
Begin DoDot:1
+5 SET FBCLAIMS=$$GET1^DIQ(161.4,1,39,"I")
SET FBYEAR=+$PIECE($$HTE^XLFDT($HOROLOG)," ",3)
+6 ;reinit sequence when year changes
IF FBYEAR'=$PIECE(FBCLAIMS,"-")
SET FBCLAIMS="-0"
+7 SET FBCLAIMS=FBYEAR_"-"_(1+$PIECE(FBCLAIMS,"-",2))
+8 ; increment and file
SET FBFDA(161.4,"1,",39)=FBCLAIMS
DO FILE^DIE(,"FBFDA")
End DoDot:1
LOCK -^FBAA(161.4,1,2)
QUIT
+9 QUIT FBCLAIMS
+10 ;
VALIDATE(TYPE,UCID) ;
+1 NEW VALID,FBSTA,FBSRC,FBINT,FBCLMT
+2 SET VALID=0
+3 IF TYPE="I"
Begin DoDot:1
+4 ; needs to be at least 14 characters long
IF $LENGTH(UCID)<14
QUIT
+5 SET FBSTA=$EXTRACT(UCID,1,5)
+6 SET FBSRC=$EXTRACT(UCID,6)
+7 SET FBINT=$EXTRACT(UCID,7)
+8 SET FBCLMT=$EXTRACT(UCID,8)
+9 SET $EXTRACT(UCID,1,8)=""
+10 IF FBSRC
IF "SEM"[FBINT
IF FBCLMT="I"
IF UCID?4N1"-"1.15N
SET VALID=1
End DoDot:1
QUIT VALID
+11 IF TYPE="O"
Begin DoDot:1
+12 ; needs to be at least 14 characters long
IF $LENGTH(UCID)<14
QUIT
+13 SET FBSTA=$EXTRACT(UCID,1,5)
+14 SET FBSRC=$EXTRACT(UCID,6)
+15 SET FBINT=$EXTRACT(UCID,7)
+16 SET FBCLMT=$EXTRACT(UCID,8)
+17 SET $EXTRACT(UCID,1,8)=""
+18 IF FBSRC
IF "SEM"[FBINT
IF "PDN"[FBCLMT
IF UCID?4N1"-"1.15N
SET VALID=1
End DoDot:1
QUIT VALID
+19 QUIT VALID
+20 ;
STATION() ; Set station
+1 NEW FBAASN,FBPOP,FBSITE,FBSN,FB
+2 DO STATION^FBAAUTL
SET FBSN=$EXTRACT(FBSN_"00000",1,5)
+3 QUIT FBSN
+4 ;
INVUCID(FBAAIN,FBSTA,FBSRC,FBINTYP,FBCLAIMS) ; populates file 162.5 field UCID and returns UCID
+1 NEW UCID,FBDAT,FBMSG,FBCLTYP
+2 ;FBAAIN = IEN of entry in file 162.5
+3 ;FBSTA = Station ID
+4 ;FBSRC = Source - 1=Fee, 2=FBCS, 3=VAPM, 4-9 - Future Use
+5 ;FBINTYP = Initiation Type - (S)canned, (E)DI, (M)anual
+6 ;FBCLAIMS = Claim Number in format YYYY-nnnn format
+7 ;
+8 ;- Claim Type is always - 'I'nstitution - for this API
SET UCID="-1"
SET FBCLTYP="I"
+9 ; Validate all input parameters populated
IF $GET(FBAAIN)
IF $GET(FBSTA)]""
IF $GET(FBSRC)]""
IF $GET(FBINTYP)]""
IF $GET(FBCLAIMS)]""
+10 IF '$TEST
Begin DoDot:1
+11 if '$GET(FBAAIN)
SET UCID=UCID_U_"UNDEFINED INVOICE IEN"
if $GET(FBSTA)=""
SET UCID=UCID_U_"UNDEFINED STATION"
+12 if $GET(FBSRC)=""
SET UCID=UCID_U_"UNDEFINED SOURCE"
if $GET(FBINTYP)=""
SET UCID=UCID_U_"UNDEFINED INITIATION TYPE"
+13 if $GET(FBCLAIMS)=""
SET UCID=UCID_U_"UNDEFINED CLAIM NUMBER"
End DoDot:1
QUIT UCID
+14 ; Validate paramaters contain acceptable values
+15 IF $LENGTH(FBSTA)<3
SET UCID=UCID_U_"INVALID STATION PARAMETER"
+16 IF FBSRC
IF FBSRC?1N
+17 IF '$TEST
SET UCID=UCID_U_"INVALID SOURCE PARAMETER"
+18 IF "SEM"[FBINTYP
IF $LENGTH(FBINTYP)=1
+19 IF '$TEST
SET UCID=UCID_U_"INVALID INITIATION TYPE PARAMETER"
+20 IF FBCLAIMS'?4N1"-"1.15N
SET UCID=UCID_U_"INVALID CLAIM NUMBER PARAMETER"
+21 IF '$DATA(^FBAAI(FBAAIN))
SET UCID=UCID_U_"INVALID ENTRY IN FILE 162.5: "_$NAME(^FBAAI(FBAAIN))
+22 IF $LENGTH(UCID)>2
QUIT UCID
+23 ; parameters passed muster
+24 SET UCID=$$UCLAIMNO(FBSTA,FBSRC,FBINTYP,FBCLTYP,FBCLAIMS)
+25 SET FBDAT(162.5,FBAAIN_",",85)=UCID
+26 DO FILE^DIE(,"FBDAT","FBMSG")
+27 IF $DATA(FBMSG("DIERR"))
SET UCID="-1^"_"DIERR TEXT: "_$GET(FBMSG("DIERR","1","TEXT",1))_$NAME(^FBAAI(FBAAIN))_"^UCID: "_UCID
+28 QUIT UCID
+29 ;
PAYUCID(DFN,FBV,FBSDI,FBAACPI,FBSTA,FBSRC,FBINTYP,FBCLTYP,FBCLAIMS) ;populates file 162 field UCID and returns UCID - Outpatient
+1 NEW C,UCID,FBDAT,FBMSG
+2 ;DFN = IEN of PATIENT in 162
+3 ;FBV = IEN of VENDOR in 162
+4 ;FBSDI = IEN of INITIAL TREATMENT DATE multiple in 162
+5 ;FBAACPI = IEN of SERVICE PROVIDED multiple in 162
+6 ;FBSTA = Station ID
+7 ;FBSRC = Source - 1=Fee, 2=FBCS, 3=VAPM, 4-9 - Future Use
+8 ;FBINTYP = Initiation Type - (S)canned, (E)DI, (M)anual
+9 ;FBCLTYP = Claim Type - (I)nstitutional, (P)rofessional, (D)ental, (N)on-Standard
+10 ;FBCLAIMS = Claim Number in format YYYY-nnnn format
+11 ;
+12 SET C=","
SET UCID="-1"
+13 ; Validate all input parameters populated
IF $GET(DFN)
IF $GET(FBV)
IF $GET(FBSDI)
IF $GET(FBAACPI)
IF $GET(FBSTA)]""
IF $GET(FBSRC)
IF $GET(FBINTYP)]""
IF $GET(FBCLTYP)]""
IF $GET(FBCLAIMS)]""
+14 IF '$TEST
Begin DoDot:1
+15 if '$GET(DFN)
SET UCID=UCID_U_"UNDEFINED IEN of PATIENT"
if '$GET(FBV)
SET UCID=UCID_U_"UNDEFINED IEN of VENDOR"
+16 if '$GET(FBSDI)
SET UCID=UCID_U_"UNDEFINED IEN of INITIAL TREATMENT DATE"
if '$GET(FBAACPI)
SET UCID=UCID_U_"UNDEFINED IEN of SERVICE PROVIDED"
+17 if $GET(FBSTA)=""
SET UCID=UCID_U_"UNDEFINED STATION"
if '$GET(FBSRC)
SET UCID=UCID_U_"UNDEFINED SOURCE VALUE"
+18 if $GET(FBINTYP)=""
SET UCID=UCID_U_"UNDEFINED INITIATION TYPE"
if $GET(FBCLTYP)=""
SET UCID=UCID_U_"UNDEFINED CLAIM TYPE"
+19 if $GET(FBCLAIMS)=""
SET UCID=UCID_U_"UNDEFINED CLAIM NUMBER"
End DoDot:1
QUIT UCID
+20 ; Validate paramaters contain acceptable values
+21 IF $LENGTH(FBSTA)<3
SET UCID=UCID_U_"INVALID STATION PARAMETER"
+22 IF FBSRC
IF FBSRC?1N
+23 IF '$TEST
SET UCID=UCID_U_"INVALID SOURCE PARAMETER"
+24 IF "SEM"[FBINTYP
IF $LENGTH(FBINTYP)=1
+25 IF '$TEST
SET UCID=UCID_U_"INVALID INITIATION TYPE PARAMETER"
+26 IF "PDN"[FBCLTYP
IF $LENGTH(FBCLTYP)=1
+27 IF '$TEST
SET UCID=UCID_U_"INVALID CLAIM TYPE PARAMETER"
+28 IF FBCLAIMS'?4N1"-"1.15NUL
SET UCID=UCID_U_"INVALID CLAIM NUMBER PARAMETER"
+29 IF '$DATA(^FBAAC(DFN,1,FBV,1,FBSDI,1,FBAACPI))
SET UCID=UCID_U_"INVALID ENTRY IN FILE 162: "_$NAME(^FBAAC(DFN,1,FBV,1,FBSDI,1,FBAACPI))
+30 IF $LENGTH(UCID)>2
QUIT UCID
+31 ; parameters passed muster
+32 SET UCID=$$UCLAIMNO(FBSTA,FBSRC,FBINTYP,FBCLTYP,FBCLAIMS)
+33 SET FBDAT(162.03,FBAACPI_C_FBSDI_C_FBV_C_DFN_C,81)=UCID
+34 DO FILE^DIE(,"FBDAT","FBMSG")
+35 IF $DATA(FBMSG("DIERR"))
SET UCID="-1^"_"DIERR TEXT: "_$GET(FBMSG("DIERR","1","TEXT",1))_$NAME(^FBAAC(DFN,1,FBV,1,FBSDI,1,FBAACPI))_"^UCID: "_UCID
+36 QUIT UCID
+37 ;
OCLMTYP(FBCURVAL) ; Get Outpatient Claim Type from the user
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DTOCNT
+2 SET FBCURVAL=$GET(FBCURVAL)
IF $GET(FBCURVAL)]""
IF "PDN"[FBCURVAL
SET DIR("B")=FBCURVAL
+3 SET DIR(0)="SO^P:P;D:D;N:N"
+4 SET DIR("L",1)="Select the Claim Type:"
+5 SET DIR("L",2)=""
+6 SET DIR("L")=" P - Professional, D - Dental, N - Non-Standard"
+7 SET DTOCNT=0
+8 FOR
DO ^DIR
Begin DoDot:1
+9 ; time out - set to "N"on-standard if no current value exists
IF $GET(DTOUT)
SET Y=$SELECT(FBCURVAL]"":FBCURVAL,1:"N")
QUIT
+10 IF Y=""
WRITE !!,"This is a required response."
QUIT
+11 IF Y="^"
SET Y=""
WRITE !!,"This is a required response. '^' is not allowed."
KILL DUOUT
QUIT
+12 IF Y="^^"
SET Y=""
WRITE !!,"This is a required response. '^' is not allowed."
KILL DUOUT
QUIT
+13 IF Y]""
IF "PDN"[Y
QUIT
+14 SET Y=""
WRITE !,"Enter a code from the list."
End DoDot:1
if Y]""
QUIT
+15 QUIT Y
+16 ;
UCIDUTL() ;EP for TEST report to validate UCID information for FB PATCH 135
+1 ;
+2 NEW DIR,FBQUIT,Y,FBSTG1,FBSRVC,FBPROG,FBID,DA,DUOUT,DIRUT,DTOUT,FBDONE
+3 ;
+4 SET FBQUIT=0
+5 SET FBDONE=0
+6 ;
+7 IF $GET(DUZ(2))=""
Begin DoDot:1
+8 WRITE !,"DUZ NOT IDENTIFIED - PLEASE LOG IN BEFORE USING FB 135 TESTING UTILTIES"
+9 SET FBDONE=1
End DoDot:1
+10 ;
+11 DO CLEAR()
+12 WRITE !,?5,"FEE BASIS PATCH 135 UNIQUE CLAIM IDENTIFIER DISPLAY"
+13 FOR
if FBDONE
QUIT
Begin DoDot:1
+14 SET DIR("A",1)="Select the UCID REPORT or the PROGRAM you are testing"
+15 SET DIR("A",2)="ENTER '^' or leave blank to EXIT"
+16 SET DIR("A")="SELECT"
+17 SET DIR(0)="SO^1:Outpatient and Inpatient UCID Display by Date Range Report"
+18 SET DIR(0)=DIR(0)_";3:Outpatient UCID Screen Display"
+19 SET DIR(0)=DIR(0)_";9:Inpatient UCID Screen Display"
+20 SET DIR("B")=""
+21 DO ^DIR
+22 KILL DIR("A")
+23 ;DEFINED IF USER ENTERS ONE UP ARROW
IF $DATA(DUOUT)
SET FBDONE=1
+24 ;DEFINED IF USER ENTERS TWO UP ARROWS
IF $DATA(DIRUT)
SET FBDONE=1
+25 ;DEFINED IF USER TIMES OUT
IF $DATA(DTOUT)
SET FBDONE=1
+26 IF '+Y
SET FBDONE=1
+27 if FBDONE
QUIT
+28 SET FBPROG=+Y
+29 IF FBPROG=1
DO UCIDRPT()
+30 ;INPATIENT
IF FBPROG=9
Begin DoDot:2
+31 SET FBQUIT=0
+32 FOR
if FBQUIT
QUIT
Begin DoDot:3
+33 ;162.5 -- FEE BASIS INVOICE FILE
SET DIC=162.5
+34 SET DIC(0)="AE"
+35 ;S DIC("S")="I $P(^(0),U,9)="""""
+36 DO ^DIC
+37 IF $DATA(DUOUT)
SET FBQUIT=1
+38 IF $DATA(DIRUT)
SET FBQUIT=1
+39 IF $DATA(DTOUT)
SET FBQUIT=1
+40 IF Y<0
SET FBQUIT=1
+41 if FBQUIT
QUIT
+42 IF (Y>0)
Begin DoDot:4
+43 ;W !,"UCID: "_$P($G(^FBAAI(+Y,5)),U,5)
+44 SET FBIEN=$PIECE(Y,U,2)
+45 SET FBNODE=^FBAAI(FBIEN,0)
+46 SET FBDATE=$PIECE(FBNODE,U,2)
+47 ;POINTER TO 161 - FEE BASIS PATIENT
SET FBVET=$PIECE(FBNODE,U,4)
+48 ;POINTER TO FILE 2 - PATIENT
SET FBPAT=$PIECE(^FBAAA(FBVET,0),U,1)
+49 ;POINTER TO FB VENDOR FILE
SET FBVNDR=$PIECE(FBNODE,U,3)
+50 SET Y=FBDATE
+51 DO DD^%DT
+52 WRITE !,$PIECE(^DPT(FBPAT,0),U,1)_" "_$PIECE(^FBAAV(FBVNDR,0),U,1)_" "_Y
+53 WRITE !?10,"UCID: "_$PIECE($GET(^FBAAI(FBIEN,5)),U,5)
+54 if ('FBDONE)&('FBQUIT)
HANG 3
End DoDot:4
+55 WRITE !!
End DoDot:3
End DoDot:2
+56 ;OUTPATIENT
IF FBPROG=3
Begin DoDot:2
+57 SET FBQUIT=0
+58 FOR
if FBQUIT
QUIT
Begin DoDot:3
+59 ; 162 -- FEE BASIS PAYMENT FILE
SET DIC="^FBAAC("
+60 ;
SET DIC(0)="AE"
+61 ;PATIENT SELECTION
DO ^DIC
+62 IF $DATA(DUOUT)
SET FBQUIT=1
+63 IF $DATA(DIRUT)
SET FBQUIT=1
+64 IF $DATA(DTOUT)
SET FBQUIT=1
+65 if FBQUIT
QUIT
+66 SET DA(1)=+Y
+67 if '+$ORDER(^FBAAC(DA(1),1,0))
QUIT
+68 SET DIC="^FBAAC("_DA(1)_",1,"
+69 DO ^DIC
+70 IF $DATA(DUOUT)
SET FBQUIT=1
+71 IF $DATA(DIRUT)
SET FBQUIT=1
+72 IF $DATA(DTOUT)
SET FBQUIT=1
+73 if FBQUIT
QUIT
+74 IF +Y<0
WRITE !,"No Fee Basis Invoice Vendors found for this patient!"
QUIT
+75 SET DA(2)=DA(1)
+76 SET DA(1)=+Y
+77 if '+$ORDER(^FBAAC(DA(2),1,DA(1),1,0))
QUIT
+78 ;INITIAL TREATMENT DATE SELECTION
SET DIC="^FBAAC("_DA(2)_",1,"_DA(1)_",1,"
+79 DO ^DIC
+80 IF $DATA(DUOUT)
SET FBQUIT=1
+81 IF $DATA(DIRUT)
SET FBQUIT=1
+82 IF $DATA(DTOUT)
SET FBQUIT=1
+83 if FBQUIT
QUIT
+84 IF +Y<0
WRITE !,"No Fee Basis Invoice DATE OF SERVICE found for this Vendor!"
QUIT
+85 SET DA(3)=DA(2)
+86 SET DA(2)=DA(1)
+87 SET DA(1)=+Y
+88 if '+$ORDER(^FBAAC(DA(3),1,DA(2),1,DA(1),1,0))
QUIT
+89 SET FBSRVC=0
+90 FOR
SET FBSRVC=$ORDER(^FBAAC(DA(3),1,DA(2),1,DA(1),1,FBSRVC))
if '+FBSRVC
QUIT
Begin DoDot:4
+91 ;POINTER TO 81 - CPT FILE
SET FBPNTR=$PIECE($GET(^FBAAC(DA(3),1,DA(2),1,DA(1),1,FBSRVC,0)),U,1)
+92 ;FB*3.5*166 - Update direct global reads of 81 file to API
WRITE !,"SERVICE: ",$PIECE($$CPT^ICPTCOD(FBPNTR),U,2)," ",$PIECE($$CPT^ICPTCOD(FBPNTR),U,3),?50,"UCID: "_$PIECE($GET(^FBAAC(DA(3),1,DA(2),1,DA(1),1,FBSRVC,5)),U,5)
End DoDot:4
+93 if ('FBDONE)&('FBQUIT)
HANG 3
+94 WRITE !!
End DoDot:3
End DoDot:2
+95 DO CLEAR()
End DoDot:1
+96 QUIT
CLEAR() ;CLEAR SCREEN
+1 NEW FBLINE
+2 FOR FBLINE=1:1:10
WRITE !
+3 QUIT
UCIDRPT() ;PROVIDES A REPORT OF ALL UCIDS IN THE SYSTEM FOR A DATE RANGE
+1 ;
+2 NEW DIR,FBQUIT,FBSTRT,FBEND,Y,FBSDATE,FBEDATE,FBDATE,FBINTLDT,FBPAT
+3 SET FBQUIT=0
+4 SET Y=DT
+5 DO DD^%DT
+6 SET FBTODAY=Y
+7 SET DIR("A")="Enter the START DATE for UCID report"
+8 SET DIR(0)="D"
+9 SET DIR("B")=FBTODAY
+10 DO ^DIR
+11 IF $DATA(DUOUT)
SET FBQUIT=1
+12 IF $DATA(DIRUT)
SET FBQUIT=1
+13 IF $DATA(DTOUT)
SET FBQUIT=1
+14 SET FBSTRT=Y
+15 IF 'FBQUIT
Begin DoDot:1
+16 SET DIR("A")="Enter the END DATE for UCID report"
+17 SET DIR(0)="D"
+18 SET DIR("B")=FBTODAY
+19 DO ^DIR
+20 IF $DATA(DUOUT)
SET FBQUIT=1
+21 IF $DATA(DIRUT)
SET FBQUIT=1
+22 IF $DATA(DTOUT)
SET FBQUIT=1
+23 SET FBEND=Y
End DoDot:1
+24 IF 'FBQUIT
Begin DoDot:1
+25 DO ^%ZIS
+26 IF 'POP
Begin DoDot:2
+27 USE IO
+28 SET Y=FBSTRT
+29 DO DD^%DT
+30 SET FBSDATE=Y
+31 SET Y=FBEND
+32 DO DD^%DT
+33 SET FBEDATE=Y
+34 WRITE !,"OUTPATIENT INVOICES INITIAL SERVICES FROM: ",FBSDATE," TO: "_FBEDATE
+35 DO OUTDSPLY(FBSTRT,FBEND)
+36 WRITE !!,"CIVIL HOSPITAL INVOICES DATE RECEIVED FROM: ",FBSDATE," TO: "_FBEDATE
+37 DO INDSPLY(FBSTRT,FBEND)
End DoDot:2
+38 DO ^%ZISC
End DoDot:1
+39 QUIT
OUTDSPLY(FBSTRT,FBEND) ;DISPLAY OUTPATIENT UCID INFORMATION FOR A DATE RANGE
+1 ; INPUT : FBSTRT : A FM DATE REPRESENTING THE STARTING DATE FOR REPORT
+2 ; FBEND : A FM DATE REPRESENTING THE ENDING DATE FOR REPORT
+3 ;
+4 NEW FBIEN,FBVNDR,FBINTLDT,FBSRVC,FBSNUM
+5 SET FBIEN=0
+6 FOR
SET FBIEN=$ORDER(^FBAAC(FBIEN))
if '+FBIEN
QUIT
Begin DoDot:1
+7 SET FBVNDR=0
+8 FOR
SET FBVNDR=$ORDER(^FBAAC(FBIEN,1,FBVNDR))
if '+FBVNDR
QUIT
Begin DoDot:2
+9 SET FBINTLDT=0
+10 FOR
SET FBINTLDT=$ORDER(^FBAAC(FBIEN,1,FBVNDR,1,FBINTLDT))
if '+FBINTLDT
QUIT
Begin DoDot:3
+11 SET FBDATE=$PIECE(^FBAAC(FBIEN,1,FBVNDR,1,FBINTLDT,0),U,1)
+12 IF (FBSTRT<=FBDATE)&(FBDATE<=FBEND)
Begin DoDot:4
+13 WRITE !
+14 ;NOW PRINT OUT PATIENT NAME, VENDOR NAME, TREATMENT DATE, AND EACH SERVICE AND UCID
+15 SET Y=FBDATE
+16 DO DD^%DT
+17 WRITE !,$PIECE(^DPT(FBIEN,0),U,1)_" "_$PIECE(^FBAAV(FBVNDR,0),U,1)_" "_Y
+18 SET FBSNUM=0
+19 FOR
SET FBSNUM=$ORDER(^FBAAC(FBIEN,1,FBVNDR,1,FBINTLDT,1,FBSNUM))
if '+FBSNUM
QUIT
Begin DoDot:5
+20 SET FBSRVC=$PIECE(^FBAAC(FBIEN,1,FBVNDR,1,FBINTLDT,1,FBSNUM,0),U,1)
+21 ;FB*3.5*166 - Update direct global reads of 81 file to API
WRITE !,"SERVICE: ",$PIECE($$CPT^ICPTCOD(FBSRVC),U,2)," ",$PIECE($$CPT^ICPTCOD(FBSRVC),U,3),?50,"UCID: "_$PIECE($GET(^FBAAC(FBIEN,1,FBVNDR,1,FBINTLDT,1,FBSNUM,5)),U,5)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
INDSPLY(FBSTRT,FBEND) ;DISPLAY CIVIL HOSPITAL UCID INFORMATION FOR A DATE RANGE
+1 ; INPUT : FBSTRT : A FM DATE REPRESENTING THE STARTING DATE FOR REPORT
+2 ; FBEND : A FM DATE REPRESENTING THE ENDING DATE FOR REPORT
+3 NEW FBIEN,DBDATE,FBVET,FBPAT,FBVNDR
+4 SET FBIEN=0
+5 FOR
SET FBIEN=$ORDER(^FBAAI(FBIEN))
if '+FBIEN
QUIT
Begin DoDot:1
+6 SET FBNODE=^FBAAI(FBIEN,0)
+7 SET FBDATE=$PIECE(FBNODE,U,2)
+8 IF (FBSTRT<=FBDATE)&(FBDATE<=FBEND)
Begin DoDot:2
+9 WRITE !
+10 ;POINTER TO 161
SET FBVET=$PIECE(FBNODE,U,4)
+11 ;POINTER TO FILE 2
SET FBPAT=$PIECE(^FBAAA(FBVET,0),U,1)
+12 SET FBVNDR=$PIECE(FBNODE,U,3)
+13 SET Y=FBDATE
+14 DO DD^%DT
+15 WRITE !,$PIECE(FBNODE,U,1)_" "_$PIECE(^DPT(FBPAT,0),U,1)_" "_$PIECE(^FBAAV(FBVNDR,0),U,1)_" "_Y
+16 WRITE !?10,"UCID: "_$PIECE($GET(^FBAAI(FBIEN,5)),U,5)
End DoDot:2
End DoDot:1
+17 QUIT
