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

FBUTL136.m

Go to the documentation of this file.
  1. FBUTL136 ;DSS/LJF - FEE BASIS UTILITY FOR UNIQUE CLAIM ID - FEE5010 (overflow from FBUTL135) ;3/23/2012
  1. ;;3.5;FEE BASIS;**135**;MAR 23, 2012;Build 3
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. Q
  1. ;--------------------- OUTPATIENT ----------------------------------------
  1. ;
  1. ENTROUTP(DFN,FBV,FBAAVID,FBCLAIMS) ; OUTPATIENT ENTER UCID
  1. ; Input: DFN - Patient ID
  1. ; FBV - Vendor IEN
  1. ; FBAAVID - Vendor Invoice Date
  1. ; FBCLAIMS - FPPS claim id
  1. ; Output: returns UCID
  1. ;
  1. N FBCLT,FBTOUT
  1. I $G(DFN),$G(FBV),$G(FBAAVID) S FBCLAIMS=$G(FBCLAIMS),FBCLT="",DTIME=$G(DTIME,300),FBTOUT=""
  1. E Q "-1"
  1. ;
  1. I FBCLAIMS="N/A" S FBCLAIMS=""
  1. I FBCLAIMS]"" D Q FBCLAIMS
  1. . S FBCLAIMS=+$P($$HTE^XLFDT($H)," ",3)_"-"_FBCLAIMS
  1. . S FBCLT=$$OCLMTYP^FBUTL135
  1. . S FBCLAIMS=$$UCLAIMNO^FBUTL135($G(FBSTA),1,"E",FBCLT,FBCLAIMS)
  1. ;
  1. F R !,"CLAIM NUMBER: ",FBANS:DTIME S FBTOUT='$T D I FBANS]"" S FBCLAIMS=FBANS Q
  1. . I FBTOUT S FBANS="-1" Q
  1. . I $TR(FBANS,"new","NEW")="NEW" D Q
  1. .. S FBANS=$$UCLAIMNO^FBUTL135 W "#: "_$E(FBANS,9,28)
  1. .. S $E(FBANS,8)=$$OCLMTYP^FBUTL135
  1. . I FBANS="??" D W ! I FBANS="" Q ; if no claim returns claim# - reask claim number
  1. .. S FBANS=$$OUTPHELP(DFN,FBV) I FBANS<1 S FBANS="" Q
  1. .. S FBCLT=$P(FBANS,U,2),FBANS=$P(FBANS,U)
  1. . I $E(FBANS)="^" S FBANS="" W !!,"This is a required response. ""^"" is not allowed.",! Q
  1. . I FBANS="?" D S FBANS="" Q
  1. .. W !!,"Enter ""NEW"" to automatically generate a new claim number,"
  1. .. W !,"or enter an existing numeric claim number in format YYYY-<nn..>,"
  1. .. W !,"or enter ?? to see a list of existing claim numbers for this vendor.",!
  1. . I FBANS="" W !!,"This is a required response.",! Q
  1. . I FBANS'?4N1"-"1.15N W !!,"** INVALID CLAIM NUMBER **",!! S FBANS="" Q
  1. . S FBANS=$$UCLAIMNO^FBUTL135(,,,$G(FBCLT),FBANS)
  1. . S $E(FBANS,8)=$$OCLMTYP^FBUTL135
  1. . I FBANS'?6N2UL4N1"-"1.15N W !!,"** INVALID CLAIM NUMBER ***",!! S (FBANS,FBCLT)=""
  1. Q FBCLAIMS
  1. ;
  1. EDITOUTP(FBXSTR,FBDA) ;
  1. ; Inputs: FBXSTR = FPPS CLAIM ID entered by user
  1. ; FBDA = DA variable containing SERVICE PROVIDED, INITIAL TREATMENT DATE, VENDOR, PATIENT
  1. ;
  1. N FBPAT,FBVEND,FBTDTG,FBSERVSE,DA,DR,FBINTYP
  1. S FBSERVSE=$G(FBDA)
  1. S FBTDTG=$G(FBDA(1))
  1. S FBVEND=$G(FBDA(2))
  1. S FBPAT=$G(FBDA(3))
  1. S FBXSTR=$G(FBXSTR)
  1. I FBXSTR'=-1,FBPAT,FBVEND,FBTDTG,FBSERVSE
  1. E Q
  1. N FBDA ; New it so we don't affect it in any way
  1. N FBDATA,FBSTA,FBSITE,FPPSCLM,FBICLAIM,FBSRC,FBINT,FBCLT,FBCLAIMS,FBPRMPT,FBHOLD,C
  1. S C=",",FBSTA=$$STATION^FBUTL135,(FBHOLD,FBICLAIM)=""
  1. S FPPSCLM=$$GET1^DIQ(162.03,FBSERVSE_C_FBTDTG_C_FBVEND_C_FBPAT_C,50,"I") ; get current value of FPPS claim id
  1. ;
  1. I FBXSTR]"" D Q ; If user entered FPPS, create UCID, save, and quit
  1. . S FBICLAIM=+$P($$HTE^XLFDT($H)," ",3)_"-"_FBXSTR
  1. . ; get claim type
  1. . S FBCLT=$$OCLMTYP^FBUTL135($G(FBCLT))
  1. . S FBICLAIM=$$PAYUCID^FBUTL135(FBPAT,FBVEND,FBTDTG,FBSERVSE,FBSTA,1,"E",FBCLT,FBICLAIM) ; Populate UCID field
  1. ; If user didn't enter a new FPPS CLAIM ID
  1. I FBXSTR="" D
  1. . ;If FPPS CLAIM ID field is populated, clear out exisitng UCID and prepare for new one
  1. . I FPPSCLM]"" S FBICLAIM(162.03,FBSERVSE_C_FBTDTG_C_FBVEND_C_FBPAT_C,81)="" D FILE^DIE(,"FBICLAIM") K FBICLAIM S FBICLAIM="" Q
  1. . ;FPPS CLAIM ID field is null get existing UCID for default
  1. . S FBICLAIM=$$GET1^DIQ(162.03,FBSERVSE_C_FBTDTG_C_FBVEND_C_FBPAT_C,81,"I")
  1. . I $E(FBICLAIM,7)'="M" S FBICLAIM="" Q ; if not a manual claim, don't use it
  1. ;
  1. I FBICLAIM="" D Q ; If UCID not populated
  1. . F S FBICLAIM=$$ENTROUTP(FBPAT,FBVEND,FBTDTG) W:FBICLAIM<1 !," REQUIRED ENTRY." Q:FBICLAIM<1 D Q:FBICLAIM>1 ; allow user to enter new UCID
  1. .. S FBSTA=$E(FBICLAIM,1,5)
  1. .. S FBSRC=$E(FBICLAIM,6)
  1. .. S FBINTYP=$E(FBICLAIM,7)
  1. .. S FBCLT=$E(FBICLAIM,8)
  1. .. S $E(FBICLAIM,1,8)=""
  1. .. S FBICLAIM=$$PAYUCID^FBUTL135(FBPAT,FBVEND,FBTDTG,FBSERVSE,FBSTA,FBSRC,FBINTYP,FBCLT,FBICLAIM) ; Populate UCID field
  1. ;
  1. ; we have an existing UCID - validate it then allow edit
  1. I '$$VALIDATE^FBUTL135("O",FBICLAIM) S FBICLAIM="" ; not valid -
  1. E D
  1. . S FBSTA=$E(FBICLAIM,1,5)
  1. . S FBSRC=$E(FBICLAIM,6)
  1. . S FBINT=$E(FBICLAIM,7)
  1. . S FBCLT=$E(FBICLAIM,8)
  1. . S $E(FBICLAIM,1,8)="",FBHOLD=FBICLAIM
  1. ;
  1. I FBICLAIM]"" S FBPRMPT=" "_FBICLAIM_" //"
  1. S FBPRMPT="CLAIM NUMBER:"_$G(FBPRMPT)_" ",FBTOUT=""
  1. F W !,FBPRMPT R FBANS:DTIME S FBTOUT='$T Q:FBTOUT D Q:FBTOUT I FBANS'="" S FBCLAIMS=FBANS Q
  1. . I FBANS="",FBICLAIM]"" D
  1. .. S FBANS=FBICLAIM
  1. . I $TR(FBANS,"new","NEW")="NEW" D Q
  1. .. S (FBSTA,FBSRC)="",FBINTYP="M",FBANS=$$UCLAIMNO^FBUTL135() W "#: "_$E(FBANS,9,28)
  1. . I FBANS="??" D I FBANS="" Q
  1. .. S FBANS=$$OUTPHELP(FBPAT,FBVEND) I FBANS<1 S FBANS="" Q
  1. .. S FBCLT=$P(FBANS,U,2),FBANS=$P(FBANS,U)
  1. . I FBANS="@" W !!," REQUIRED ENTRY.",! S FBANS="" Q
  1. . I $E(FBANS)="^" S FBANS="" W !!,"This is a required response. ""^"" is not allowed.",! Q
  1. . I FBANS="?" D S FBANS="" Q
  1. .. W !!,"Enter ""NEW"" to automatically generate a new claim number,"
  1. .. W !,"or enter an existing numeric claim number in format YYYY-<nn..>,"
  1. .. W !,"or enter ?? to see a list of existing claim numbers for this vendor.",!
  1. . I FBANS="" S FBANS=FBHOLD
  1. . I FBANS?4N1"-"1.15N D
  1. .. S FBANS=$$UCLAIMNO^FBUTL135($G(FBSITE),$G(FBSRC),$G(FBINT),$G(FBCLT),FBANS)
  1. . I FBANS'?6N2UL4N1"-"1.15N W !!,"** INVALID CLAIM NUMBER ****",!! S FBANS=""
  1. I FBTOUT S DTOUT=FBTOUT,FBXSTR=-1 Q ; flag not to save FPPS EDIT
  1. I $G(FBCLAIMS)]"" D I FBCLAIMS Q
  1. . S FBSTA=$E(FBCLAIMS,1,5)
  1. . S FBSRC=$E(FBCLAIMS,6)
  1. . S FBINT=$E(FBCLAIMS,7)
  1. . S FBCLT=$$OCLMTYP^FBUTL135($E(FBCLAIMS,8))
  1. . S $E(FBCLAIMS,1,8)=""
  1. . S FBCLAIMS=$$PAYUCID^FBUTL135(FBPAT,FBVEND,FBTDTG,FBSERVSE,FBSTA,FBSRC,FBINT,FBCLT,FBCLAIMS)
  1. . I FBCLAIMS<1 S FBCLAIMS=""
  1. ;
  1. N DA
  1. S DA=$G(FBSERVSE)
  1. S DA(1)=$G(FBTDTG)
  1. S DA(2)=$G(FBVEND)
  1. S DA(3)=$G(FBPAT)
  1. S FBXSTR=$G(FBXSTR)
  1. W !!,"** INVALID CLAIM NUMBER *****",!! D EDITOUTP(FBXSTR,.DA) ; Restart edit
  1. Q
  1. OUTPHELP(DFN,FBV) ; ?? response
  1. I $G(DFN),$G(FBV) ; gotta have a DFN, and a Vendor number
  1. E Q 0
  1. N DTG,E7,E7TEXT,FBINT,FBIX,RETDIR,FBVENDT
  1. N DTOUT,DUOUT,DIRUT,DIROUT,X,Y,C
  1. N FBDOS,FBSVC,UCID,FBYEAR,OLINE,CNT,CLMID,CLMTYP
  1. S FBTOUT=""
  1. S E7TEXT("E")="1-EDI",E7TEXT("S")="2-SCANNED",E7TEXT("M")="3-MANUAL"
  1. S (CNT,DTG)=0,RETDIR="",C=","
  1. S FBDOS=0
  1. F S FBDOS=$O(^FBAAC(DFN,1,FBV,1,FBDOS)),FBSVC=0 Q:'FBDOS D ; date of service
  1. . F S FBSVC=$O(^FBAAC(DFN,1,FBV,1,FBDOS,1,FBSVC)) Q:'FBSVC D ; service provided
  1. .. S UCID=$P($G(^FBAAC(DFN,1,FBV,1,FBDOS,1,FBSVC,5)),U,5)
  1. .. I UCID="" Q
  1. .. I '$$VALIDATE^FBUTL135("O",UCID) Q
  1. .. I $E(UCID,7)="E" Q ; Quit if Initiation Type is "E"DI
  1. .. S CLMTYP=$E(UCID,8)
  1. .. S FBYEAR=$$FMTE^XLFDT(FBDOS),FBVENDT=$$GET1^DIQ(162.02,FBDOS_C_FBV_C_DFN_C,.01,"I")
  1. .. S CLMID=$E(UCID,9,28) ; Only want the YYYY-<xxxxx>
  1. .. S OLINE=$E(CLMID_" ",1,22)
  1. .. S OLINE=OLINE_$E(FBVENDT_" ",1,14) ; Vendor date
  1. .. S OLINE=OLINE_"("_UCID_")" ; Full UCID
  1. .. S UCID("LIST",9999999-FBVENDT,FBSVC,CLMID)=OLINE_"^^"_CLMTYP
  1. ;
  1. I '$D(UCID("LIST")) W !!,?5,"NO RECENT CLAIM NUMBERS FOR THIS PATIENT/VENDOR" Q "" ; Nothing to display
  1. E W !!,?4,"RECENT CLAIM NUMBERS FOR THIS PATIENT/VENDOR",!
  1. K OLINE S OLINE=$NA(UCID("LIST"))
  1. ; Display list of prospects
  1. F CNT=1:1 S OLINE=$Q(@OLINE) Q:OLINE="" D Q:RETDIR Q:$G(DTOUT) Q:$G(DUOUT)
  1. . I '(CNT-1#5) W !," # CLAIM NO VEND INV DATE COMPLETE UCID"
  1. . S CNT(CNT)=$J(CNT,2)_": "_$P(@OLINE,"^^"),CNT(CNT,"CLMID")=$QS(OLINE,4)_U_$P(@OLINE,"^^",2) W !,CNT(CNT)
  1. . I '(CNT#5) D
  1. .. N DA,DIR
  1. .. S DIR(0)="NAO^1:"_CNT,DIR("A",1)="Press <RETURN> to see more, '^' to exit this list, or",DIR("A")="CHOOSE 1-"_CNT_": " D ^DIR
  1. .. ;Possible options - X is a number = done. or X is null or X is "^"
  1. .. I X?1.2N S RETDIR=X Q
  1. I '$G(DTOUT),'$G(DUOUT)
  1. E S RETDIR="-1^"_$G(DTOUT)_"."_$G(DUOUT) K DTOUT,DUOUT Q RETDIR ; time out or opt out
  1. ; no opt out, no time out
  1. I 'RETDIR D ; user did not select any entries so far, so display final choice prompt
  1. . N DA,DIR
  1. . S CNT=CNT-1,DIR(0)="NAO^1:"_CNT,DIR("A",1)="Press <RETURN> to return to main prompt, or",DIR("A")="CHOOSE 1-"_CNT_":" D ^DIR
  1. . I X?1.2N S RETDIR=X
  1. I '$G(DTOUT),'$G(DUOUT)
  1. E S RETDIR="-1^"_$G(DTOUT)_"."_$G(DUOUT) K DTOUT,DUOUT Q RETDIR ; time out or opt out
  1. I RETDIR Q $G(CNT(RETDIR,"CLMID")) ; quit with the selected claim
  1. Q RETDIR
  1. ;
  1. ;
  1. ;--------------------- INPATIENT ----------------------------------------
  1. ;
  1. ENTINPAT(FBSTA,FBSRC,FBINT,FBCLT,FBCLAIMS,FBVEND) ;Returns UCID; FB*3.5*135
  1. ; Input: FBSTA = Station
  1. ; FBSRC = Source
  1. ; FBINT = Initiation Type
  1. ; FBCLT = Claim Type
  1. ; FBCLAIMS = FPPS CLAIM ID - replaces sequence number
  1. ; FBVEND = Vendor IEN
  1. ;
  1. ; Output: UCID
  1. ;
  1. N FBRETVAL,FBTOUT,FBANS
  1. K DTOUT
  1. S FBSTA=$G(FBSTA),FBSRC=$G(FBSRC),FBINT=$G(FBINT),FBCLT=$G(FBCLT),FBCLAIMS=$G(FBCLAIMS),FBVEND=$G(FBVEND),(FBRETVAL,FBTOUT,FBUOUT,FBANS)=""
  1. I FBCLAIMS="N/A" S FBCLAIMS=""
  1. I FBCLAIMS]"" D Q FBCLAIMS
  1. . S FBCLAIMS=+$P($$HTE^XLFDT($H)," ",3)_"-"_FBCLAIMS
  1. . S FBCLAIMS=$$UCLAIMNO^FBUTL135(FBSTA,FBSRC,"E",FBCLT,FBCLAIMS)
  1. F R !,"CLAIM NUMBER: ",FBANS:DTIME S FBTOUT='$T Q:FBTOUT D Q:FBTOUT I FBANS'="" S FBCLAIMS=FBANS Q
  1. . I $TR(FBANS,"new","NEW")="NEW" S FBANS=$$UCLAIMNO^FBUTL135(FBSTA,$G(FBSRC),"M",$G(FBCLT)) W "#: "_$E(FBANS,9,28) Q
  1. . I FBANS="??" S FBANS=$$ENTHELP(FBVEND,.FBTOUT,.FBUOUT) S:FBUOUT (FBANS,FBUOUT)="" Q:FBANS=""
  1. . I $E(FBANS)="^" S FBANS="" W !!,"This is a required response. ""^"" is not allowed.",! Q
  1. . I FBANS="?" D S FBANS="" Q
  1. .. W !!,"Enter ""NEW"" to automatically generate a new claim number,"
  1. .. W !,"or enter an existing numeric claim number in format YYYY-<nn..>,"
  1. .. W !,"or enter ?? to see a list of existing claim numbers for this vendor.",!
  1. . I FBANS="" W !!," REQUIRED ENTRY.",! Q
  1. . I FBANS?4N1"-"1.15N S FBANS=$$UCLAIMNO^FBUTL135(FBSTA,$G(FBSRC),$G(FBINT),$G(FBCLT),FBANS)
  1. . I FBANS'?6N2UL4N1"-"1.15N W !!,"*** INVALID CLAIM NUMBER ***",!! S FBANS=""
  1. I 'FBTOUT,'FBUOUT Q FBCLAIMS
  1. I FBTOUT S DTOUT=FBTOUT
  1. I FBUOUT S DUOUT=FBUOUT
  1. Q ""
  1. ;
  1. ENTHELP(FBVEND,FBTOUT,FBUOUT) ; Help for UCID in "FBCH ENTER PAYMENT" ; FB*3.5*135
  1. I $G(DFN),$G(FBVEND) ; gotta have a DFN, and a Vendor number
  1. E Q 0
  1. N CLMID,CNT,DTG,E7,E7TEXT,FBINT,FBIX,OLINE,RETDIR,UCIDLIST,YR
  1. N DTOUT,DUOUT,DIRUT,DIROUT,X,Y
  1. S (FBTOUT,FBUOUT)=""
  1. S E7TEXT("E")="1-EDI",E7TEXT("S")="2-SCANNED",E7TEXT("M")="3-MANUAL"
  1. S (CNT,DTG)=0,RETDIR=""
  1. ; Build list of prospects
  1. F S DTG=$O(^FBAAI("AG",DFN,DTG)),FBIX=0 Q:'DTG D
  1. . F S FBIX=$O(^FBAAI("AG",DFN,DTG,FBIX)) Q:'FBIX D
  1. .. K FBINT D GETS^DIQ(162.5,FBIX,"2;46;85","IE","FBINT")
  1. .. I FBINT("162.5",FBIX_",",2,"I")'=FBVEND Q ; Quit if vendor doesn't match
  1. .. I FBINT("162.5",FBIX_",",85,"E")="" Q ; Quit if no UCID
  1. .. I $E(FBINT("162.5",FBIX_",",85,"E"),7)="E" Q ; Quit if Initiation Type is "E"DI
  1. .. I '$$VALIDATE^FBUTL135("I",FBINT("162.5",FBIX_",",85,"E")) Q ; Quit if not valid
  1. .. K OLINE M OLINE=FBINT("162.5",FBIX_",")
  1. .. S UCIDLIST=FBINT("162.5",FBIX_",",85,"E")
  1. .. S YR=(9999999.999999-$G(OLINE(46,"I"))),CLMID=$P(UCIDLIST,"-",1,2),E7=$E(UCIDLIST,7)
  1. .. I $D(E7TEXT(E7)) S E7=E7TEXT(E7)
  1. .. E S E7="4-"_E7
  1. .. S OLINE=$E($G(OLINE(85,"E"))_" ",9,30) ; Only want the YYYY-<xxxxx>
  1. .. S OLINE=OLINE_$E($G(OLINE(46,"E"))_" ",1,14) ; Vendor date
  1. .. S OLINE=OLINE_"("_$G(OLINE(85,"E"))_")" ; Full UCID
  1. .. S UCIDLIST("LIST",YR,E7,CLMID,FBIX)=OLINE
  1. K OLINE S OLINE=$NA(UCIDLIST("LIST"))
  1. I '$D(UCIDLIST("LIST")) W !!,?5,"NO RECENT CLAIM NUMBERS FOR THIS PATIENT/VENDOR",! Q "" ; Nothing to display
  1. E W !!,?4,"RECENT CLAIM NUMBERS FOR THIS PATIENT/VENDOR",!
  1. ; Display list of prospects
  1. F CNT=1:1 S OLINE=$Q(@OLINE) Q:OLINE="" D Q:RETDIR Q:$G(DTOUT) Q:$G(DUOUT)
  1. . I '(CNT-1#5) W !," # CLAIM NO VEND INV DATE COMPLETE UCID"
  1. . S CNT(CNT)=$J(CNT,2)_": "_@OLINE,CNT(CNT,"CLMID")=$QS(OLINE,4)_U_$QS(OLINE,3) W !,CNT(CNT)
  1. . I '(CNT#5) D
  1. .. N DA,DIR
  1. .. S DIR(0)="NAO^1:"_CNT,DIR("A",1)="Press <RETURN> to see more, '^' to exit this list, or",DIR("A")="CHOOSE 1-"_CNT_": " D ^DIR
  1. .. ;Possible options - X is a number = done. or X is null or X is "^"
  1. .. I X?1.2N S RETDIR=X Q
  1. S FBTOUT=$G(DTOUT),FBUOUT=$G(DUOUT)
  1. I 'FBTOUT,'FBUOUT
  1. E Q "" ; time out or opt out
  1. ; no opt out, no time out
  1. I 'RETDIR D ; user did not select any entries so far, so display final choice prompt
  1. . N DA,DIR
  1. . S CNT=CNT-1,DIR(0)="NAO^1:"_CNT,DIR("A",1)="Press <RETURN> to return to main prompt, or",DIR("A")="CHOOSE 1-"_CNT_":" D ^DIR
  1. . I X?1.2N S RETDIR=X
  1. S FBTOUT=$G(DTOUT),FBUOUT=$G(DUOUT)
  1. I 'FBTOUT,'FBUOUT
  1. E Q "" ; time out or opt out
  1. I RETDIR Q $P($G(CNT(RETDIR,"CLMID")),U) ; quit with the selected claim
  1. Q RETDIR
  1. ;
  1. EDINPAT(FBXSTR,FBI) ; EDIT UNIQUE CLAIM ID for FEE BASIS INVOICE file - 162.5
  1. ; Input: FBXSTR = FPPS value entered by user for FPPS
  1. ; FBI = IEN of Invoice record
  1. ;
  1. ; Output: UCID
  1. ;
  1. N FBDATA,FBFPPSCL,FBICLAIM,FBSITE,FBSTA,FBSRC,FBINT,FBCLT,FPPSCLM,FBCLAIMS,FBPRMPT,FBHOLD,FBVEND
  1. S FBXSTR=$G(FBXSTR),FBI=$G(FBI),FBSTA=$$STATION^FBUTL135,FBVEND=$$GET1^DIQ(162.5,FBI_",",2,"I"),FPPSCLM=$$GET1^DIQ(162.5,FBI_",",56,"I"),(FBHOLD,FBICLAIM)=""
  1. I FBXSTR'=-1,FBI
  1. E Q
  1. ;
  1. I FBXSTR]"" D Q ; If user entered FPPS, create UCID, save, and quit
  1. . S FBICLAIM=+$P($$HTE^XLFDT($H)," ",3)_"-"_FBXSTR
  1. . S FBICLAIM=$$INVUCID^FBUTL135(FBI,FBSTA,1,"E",FBICLAIM) ; Populate UCID field
  1. ;
  1. ; If user didn't enter a new FPPS CLAIM ID
  1. I FBXSTR="" D
  1. . ;If FPPS CLAIM ID field is populated, clear out exisitng UCID and prepare for new one
  1. . I FPPSCLM]"" S FBICLAIM(162.5,FBI_",",85)="" D FILE^DIE(,"FBICLAIM") K FBICLAIM S FBICLAIM="" Q
  1. . ;FPPS CLAIM ID field is null get existing UCID for default
  1. . S FBICLAIM=$$GET1^DIQ(162.5,FBI_",",85,"I") I $E(FBICLAIM,7)'="M" S FBICLAIM="" ; if not a manual claim, don't use it
  1. ;
  1. I FBICLAIM="" D Q ; If UCID not populated
  1. . S FBICLAIM=$$ENTINPAT(,1,"M","I",,FBVEND) ; allow user to enter new UCID
  1. . I '$G(DTOUT),'$G(DUOUT),FBICLAIM]"" D
  1. .. S FBSITE=$E(FBICLAIM,1,5)
  1. .. S FBSRC=$E(FBICLAIM,6)
  1. .. S FBINT=$E(FBICLAIM,7)
  1. .. S $E(FBICLAIM,1,8)=""
  1. .. S FBICLAIM=$$INVUCID^FBUTL135(FBI,FBSITE,FBSRC,FBINT,FBICLAIM) ; Populate UCID field
  1. ; we have an existing UCID - validate it then allow edit
  1. ;
  1. I '$$VALIDATE^FBUTL135("I",FBICLAIM) S FBICLAIM="" ; not valid -
  1. E D
  1. . S FBSITE=$E(FBICLAIM,1,5) I FBSITE="" S FBSITE=FBSTA
  1. . S FBSRC=$E(FBICLAIM,6) I FBSRC="" S FBSRC=1
  1. . S FBINT=$E(FBICLAIM,7) I FBINT="" S FBINT="M"
  1. . S FBCLT="I"
  1. . S $E(FBICLAIM,1,8)="",FBHOLD=FBICLAIM
  1. ;
  1. I FBICLAIM]"" S FBPRMPT=" "_FBICLAIM_" //"
  1. S FBPRMPT="CLAIM NUMBER:"_$G(FBPRMPT)_" ",(FBTOUT,FBUOUT)=""
  1. F W !,FBPRMPT R FBANS:DTIME S FBTOUT='$T Q:FBTOUT D Q:FBTOUT Q:FBUOUT I FBANS'="" S FBCLAIMS=FBANS Q
  1. . I FBANS="",'FBTOUT,FBICLAIM]"" S FBANS=FBICLAIM Q ; accept existing UCID suffix
  1. . I $TR(FBANS,"new","NEW")="NEW" S FBANS=$$UCLAIMNO^FBUTL135(FBSTA,$G(FBSRC),$G(FBINT),$G(FBCLT)) W "#: "_$E(FBANS,9,28) Q
  1. . I FBANS="??" D Q:FBANS=""
  1. .. S FBANS=$$ENTHELP(FBVEND,.FBTOUT,.FBUOUT)
  1. .. I FBTOUT S (FBTOUT,FBANS)="" Q
  1. .. I FBUOUT Q
  1. .. I FBANS="" Q
  1. . I FBANS="@" W !!," REQUIRED ENTRY.",! S FBANS="" Q
  1. . I $E(FBANS)="^" S FBANS="" W !!,"This is a required response. ""^"" is not allowed.",! Q
  1. . I FBANS="?" D S FBANS="" Q
  1. .. W !!,"Enter ""NEW"" to automatically generate a new claim number,"
  1. .. W !,"or enter an existing numeric claim number in format YYYY-<nn..>,"
  1. .. W !,"or enter ?? to see a list of existing claim numbers for this vendor.",!
  1. . I FBANS="" S FBANS=FBHOLD Q
  1. . I FBANS?4N1"-"1.15N S FBANS=$$UCLAIMNO^FBUTL135($G(FBSITE),$G(FBSRC),$G(FBINT),$G(FBCLT),FBANS)
  1. . I FBANS'?6N2UL4N1"-"1.15N W !!,"*** INVALID CLAIM NUMBER ****",!! S FBANS="" Q
  1. I FBTOUT S DTOUT=FBTOUT,FBX=-1 ; flag not to save FPPS EDIT
  1. I FBUOUT S DUOUT=FBUOUT,FBX=-1 ; flag not to save FPPS EDIT
  1. I 'FBTOUT,'FBUOUT D
  1. . I FBANS?4N1"-"1.15N D
  1. .. S FBANS=FBSTA_"1MI"_FBANS
  1. . S FBSTA=$E(FBANS,1,5)
  1. . S FBSRC=$E(FBANS,6)
  1. . S FBINT=$E(FBANS,7)
  1. . S $E(FBANS,1,8)=""
  1. . S FBICLAIM=$$INVUCID^FBUTL135(FBI,FBSTA,FBSRC,FBINT,FBANS)
  1. . I +FBICLAIM=-1 W !!,"*** INVALID CLAIM NUMBER *****",!! D EDINPAT(FBXSTR,FBI) ; Populate UCID field
  1. Q