- RCDMCUT1 ;HEC/SBW - Utility Functions for Hold Debt to DMC Project ;30/AUG/2007
- ;;4.5;Accounts Receivable;**253,347**;Mar 20, 1995;Build 47
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- Q
- ;
- HOLDCHK(IEN,DFN) ;Check if receivable shouldn't be sent to DMC
- ;Dont refer receivables for veterans who are (return 1)
- ; 1. "DMC Debt Valid" field = NULL and
- ; SC 50% to 100% or in receipt of VA Pension and "DMC Debt Valid"
- ; For this case only update DMC Debt Valid Field to Pending
- ; 2. "DMC Debt Valid" is Pending or NO
- ;Refer receivables for veterans who are (return 0)
- ; 1. "DMC Debt Valid" is "YES"
- ; 2. "DMC Debt Valid" is NULL and
- ; not SC 50% to 100% and not in receipt of a VA Pensions
- ;
- ;INPUT
- ; IEN - Internal Entry Number for Accounts Recievable File
- ; DFN - Internal Entry Number to Patient (#2) file
- ;OUTPUT
- ; 1 - Don't sent the Debt to DMC
- ; 0 - Debt can be sent to DMC
- ;
- N OUT,DMCVALID,DMCELIG
- S OUT=0
- ;Quit if invalid IEN or DFN passed
- Q:$G(IEN)'>0!($G(DFN)'>0) OUT
- ;Get DMC Debt Valid field
- S DMCVALID=$$GET1^DIQ(430,+$G(IEN)_",",125,"E")
- ;If DMC Debt Valid is No or Pending don't refer to DMC
- S:DMCVALID="NO"!(DMCVALID="PENDING") OUT=1
- ;If DMC Debt Valid is Yes refer to DMC
- S:DMCVALID="YES" OUT=0
- ;Check if Vet is SC 50% to 100% or in Receipt of VA Pension
- S DMCELIG=+$$DMCELIG^RCDMCUT1(+$G(DFN))
- ;If DMC Debt Valid is Null & SC 50% to 100% or Receiving VA Pension
- ;refer to DMC
- D:DMCVALID=""&(DMCELIG>0)
- . S OUT=1
- . ;Update DMC Valid Indicator to Pending
- . D UPDTDMC^RCDMCUT1(IEN,"P",1)
- ;If DMC Debt Valid is Null & NOT SC 50%to100% & NOT Receiving VA Pension
- ;don't refer to DMC
- S:DMCVALID=""&(DMCELIG'>0) OUT=0
- Q OUT
- ;
- DMCELIG(DFN) ;Checks Bill Debtor SC% and Receipt of VA Pension Values
- ;INPUT:
- ; DFN - Pointer Value to Patient (#2) file
- ;OUTPUT:
- ; Returns 0 if not SC 50% to 100% and not receiving a VA Pension
- ; Returns "1^ SC % ^ VA Pension ^ A&A Benefits ^ Housbound Benefits"
- ; if SC 50% to 100% or Receiving a VA Pension.
- ; Should also consider Vets who are receiving A&A or
- ; Housebound benefits as Receiving VA a VA Pension.
- ; The 2nd piece will be the SC % if SC 50% to 100%.
- ; The 3rd piece will be a 1 if Receiving a VA Pension.
- ; If not SC 50% to 100% or Receiving a VA Pension then
- ; The 4th piece will be the A&A Benefits.
- ; The 5th piece will be the Housebound Benefits.
- ;
- N OUT
- ;Protect the VADPT variables to prevent errors with ^RCDMC90 routine
- N VAHOW,VAROOT,VAERR,VAEL,VAMB,VADM,VASV,VAPA,VATEST,VAOA,VAINDT,VAIN
- N VAIP,VAPD,VARP,VASD,VA,VADMVT
- S OUT=0
- ;Quit if no DFN passed
- Q:$G(DFN)'>0 OUT
- ;Get Eligibility Data
- D ELIG^VADPT
- ;Quit if ^DPT(DFN,0) not defined
- Q:$G(VAERR)>0 OUT
- ;Get monetary benefit data
- D MB^VADPT
- ;SERVICE CONNECTED? Field- If SC the SC% returned in the 2nd piece.
- S:$P($G(VAEL(3)),U,2)>49 $P(OUT,U,1)=1,$P(OUT,U,2)=$P(VAEL(3),U,2)
- ;RECEIVING A VA PENSION?
- S:$P($G(VAMB(4)),U,1)>0 $P(OUT,U,1)=1,$P(OUT,U,3)=$P(VAMB(4),U,1)
- D:+OUT'>0
- . ;RECEIVING A&A BENEFITS?
- . S:$P($G(VAMB(1)),U,1)>0 $P(OUT,U,1)=1,$P(OUT,U,4)=$P(VAMB(1),U,1)
- . ;RECEIVING HOUSEBOUND BENEFITS?
- . S:$P($G(VAMB(2)),U,1)>0 $P(OUT,U,1)=1,$P(OUT,U,5)=$P(VAMB(2),U,1)
- D KVAR^VADPT
- Q OUT
- ;
- UPDTDMC(IEN,VAL,DELBY) ;Update the DMC Debt Valid Field
- ;INPUT
- ; IEN - Internal Entry Number of Accounts Receivable (#430) file
- ; VAL - DMC Debt Valid Value ("P", "Y", "N" or "@"),
- ; If "@" pass the field will be deleted
- ; DELBY - Used to delete the "DMC Debt Valid Edited By" field when
- ; updated by the Nightly Background Job
- ;Output
- ; No output
- ;
- N DA,DIE,DR,X,Y
- Q:$G(IEN)'>0
- Q:"^Y^N^P^@^"'[(U_$G(VAL)_U)
- L +^PRCA(430,IEN,12.1):30
- ;Quit if another user is editing this entry
- I '$T Q
- S DA=IEN
- S DIE=430
- S DR="125////"_VAL
- S:$G(DELBY)>0 DR=DR_";126///@"
- D ^DIE
- L -^PRCA(430,IEN,12.1)
- Q
- ;
- GETDEM(DFN) ; Get data from Patient (#2) file
- ;INPUT:
- ; DFN - Pointer Value to Patient (#2) file
- ;OUTPUT:
- ; DEM^VADPT VADM array as spelled out in PIMS Technical Manual
- ;
- ;Calling routines needs to New or Kill following Variables by calling
- ; D KVAR^VADPT
- ; VADM,VAERR,VA
- ;
- N OUT,Y
- S OUT=0
- ;Quit if no DFN passed
- Q:$G(DFN)'>0 OUT
- ;Get Demographic Data
- D DEM^VADPT
- ;Quit if ^DPT(DFN,0) not defined
- Q:$G(VAERR)>0 OUT
- ;Calls Successful
- S OUT=1
- Q OUT
- ;
- FIRSTPAR(IEN430) ;Check if this is a First Party bill
- ;INPUT
- ; IEN430 - Internal Entry Number for Accounts Receivable File
- ;OUTPUT
- ; Returns a 0 if not First Party Bill
- ; Returns a 1 if First Party Bill
- ;
- N FLD,FIRST,IEN340
- ;Set default to zero
- S FIRST=0
- S IEN430=+$G(IEN430)
- ;Get DEBTOR Field Value in Account Receivable File
- S IEN340=+$P($G(^PRCA(430,IEN430,0)),U,9)
- ;If .01 field in AR Debtor File points to the Patient file
- ;then this is a First Party Debt
- S FLD=$P($G(^RCD(340,IEN340,0)),U,1)
- S:FLD["DPT" FIRST=1_U_$P(FLD,";",1)
- Q FIRST
- ;
- GETSERDT(BILLNUM) ; Get most recent Outpatient Date, Inpatient Date and RX Date
- ; from the IB Action (#350) file for the corresponding bill
- ;INPUT
- ; BILLNUM - Bill No. (.01) field in AR (#430) file
- ;OUTPUT
- ; 0 - No data
- ; 1 ^ Outpatient Date ^ Discharge Date ^ RX/Refill Date ^ Status
- N OUT,IEN
- S OUT=0,IEN=0
- ;Quit if a Bill Number wasn't passed
- Q:$G(BILLNUM)']"" OUT
- F S IEN=$O(^IB("ABIL",BILLNUM,IEN)) Q:IEN'>0 D
- . N IBDATA,IENS,DFN,ACTTYPE,RESULT,DTBILLFR,BILGROUP,OPDT,DISCHARG,RXDT,STATUS,RXNUM,RXNAM
- . S IENS=IEN_","
- . D GETS^DIQ(350,IENS,".02;.03;.04;.14","IN","IBDATA")
- . S DFN=$G(IBDATA(350,IENS,.02,"I"))
- . S ACTTYPE=$G(IBDATA(350,IENS,.03,"I"))
- . S RESULT=$G(IBDATA(350,IENS,.04,"I"))
- . S DTBILLFR=$G(IBDATA(350,IENS,.14,"I"))
- . S STATUS=$$GET1^DIQ(350,IENS,.05)
- . ;
- . ;Child charge. Need to get Parent Charge
- . I $P(RESULT,":",1)=350 D
- . . S IENS=+$P(RESULT,":",2)_","
- . . ;Quit if the entry is the parent
- . . Q:+IENS=IEN
- . . D GETS^DIQ(350,IENS,".02;.03;.04;.14","IN","IBDATA")
- . . S DFN=$G(IBDATA(350,IENS,.02,"I"))
- . . S ACTTYPE=$G(IBDATA(350,IENS,.03,"I"))
- . . S RESULT=$G(IBDATA(350,IENS,.04,"I"))
- . . S DTBILLFR=$G(IBDATA(350,IENS,.14,"I"))
- . . S STATUS=$$GET1^DIQ(350,IENS,.05)
- . Q:$G(DFN)']""
- . ;
- . ;Get Billing Group in the IB Action Type File. If internal Set
- . ;Code value is 4, then this is an Outpatient Visit (From STMT^IBRFN1)
- . ;and can use Date Billed From for the Outpatient Visit Date
- . S BILGROUP=$$GET1^DIQ(350.1,+ACTTYPE_",",.11,"I")
- . ;
- . ;Outpatient Event
- . I BILGROUP=4!($P(RESULT,":",1)=44)!($P(RESULT,":",1)=409.68) D Q
- . . I $P(RESULT,":",1)=44 S OPDT=$P($P(RESULT,";",2),":",2)
- . . I $P(RESULT,":",1)=409.68 S OPDT=$$GET1^DIQ(409.68,+$P(RESULT,":",2)_",",.01,"I")
- . . I $G(OPDT)'>0 S OPDT=DTBILLFR
- . . I $G(OPDT)>$P(OUT,U,2) S $P(OUT,U,1)=1,$P(OUT,U,2)=OPDT,$P(OUT,U,5)=STATUS
- . ;
- . ;Quit if RESULTING FROM field is blank
- . Q:$G(RESULT)']""
- . ;
- . ;Inpatient Event
- . I $P(RESULT,":",1)=405!($P(RESULT,":",1)=45) D Q
- . . S VAIP("E")=$P($P(RESULT,";",1),":",2)
- . . ;Call to get Inpatient data
- . . D IN5^VADPT
- . . Q:VAERR>0
- . . S DISCHARG=$P($G(VAIP(17,1)),U,1)
- . . ;Ensure get most current Discharge Date
- . . I DISCHARG>$P(OUT,U,3) S $P(OUT,U,1)=1,$P(OUT,U,3)=DISCHARG,$P(OUT,U,5)=STATUS
- . . D KVAR^VADPT
- . ;
- . ;RX Event
- . I $P(RESULT,":",1)=52 D Q
- . . N PSOFILE,IENS,FLD
- . . ;Set up for RX Refills
- . . I $P(RESULT,";",2)]"" D
- . . . S PSOFILE=52.1
- . . . S IENS=+$P($P(RESULT,";",2),":",2)_","_+$P($P(RESULT,";",1),":",2)_","
- . . . S RXDT=$$GET1^PSODI(PSOFILE,IENS,.01,"I")
- . . . S RXNAM="1^TBD",RXNUM="1^TBD"
- . . ;Set up for RX Data (No refill)
- . . I $P(RESULT,";",2)']"" D
- . . . S PSOFILE=52
- . . . S IENS=+$P($P(RESULT,";",1),":",2)_","
- . . . S RXDT=$$GET1^PSODI(PSOFILE,IENS,1,"I")
- . . . S RXNUM=$$GET1^PSODI(PSOFILE,IENS,.01,"I")
- . . . S RXNAM=$$GET1^PSODI(PSOFILE,IENS,6,"E")
- . . ;Ensure get most current RX/Refill Date
- . . I RXDT>$P(OUT,U,4) S $P(OUT,U,1)=1,$P(OUT,U,4)=$P(RXDT,U,2),$P(OUT,U,5)=STATUS,$P(OUT,U,6)=$P(RXNUM,U,2),$P(OUT,U,7)=$P(RXNAM,U,2)
- Q OUT
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDMCUT1 8296 printed Jan 18, 2025@02:44:59 Page 2
- RCDMCUT1 ;HEC/SBW - Utility Functions for Hold Debt to DMC Project ;30/AUG/2007
- +1 ;;4.5;Accounts Receivable;**253,347**;Mar 20, 1995;Build 47
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 QUIT
- +5 ;
- HOLDCHK(IEN,DFN) ;Check if receivable shouldn't be sent to DMC
- +1 ;Dont refer receivables for veterans who are (return 1)
- +2 ; 1. "DMC Debt Valid" field = NULL and
- +3 ; SC 50% to 100% or in receipt of VA Pension and "DMC Debt Valid"
- +4 ; For this case only update DMC Debt Valid Field to Pending
- +5 ; 2. "DMC Debt Valid" is Pending or NO
- +6 ;Refer receivables for veterans who are (return 0)
- +7 ; 1. "DMC Debt Valid" is "YES"
- +8 ; 2. "DMC Debt Valid" is NULL and
- +9 ; not SC 50% to 100% and not in receipt of a VA Pensions
- +10 ;
- +11 ;INPUT
- +12 ; IEN - Internal Entry Number for Accounts Recievable File
- +13 ; DFN - Internal Entry Number to Patient (#2) file
- +14 ;OUTPUT
- +15 ; 1 - Don't sent the Debt to DMC
- +16 ; 0 - Debt can be sent to DMC
- +17 ;
- +18 NEW OUT,DMCVALID,DMCELIG
- +19 SET OUT=0
- +20 ;Quit if invalid IEN or DFN passed
- +21 if $GET(IEN)'>0!($GET(DFN)'>0)
- QUIT OUT
- +22 ;Get DMC Debt Valid field
- +23 SET DMCVALID=$$GET1^DIQ(430,+$GET(IEN)_",",125,"E")
- +24 ;If DMC Debt Valid is No or Pending don't refer to DMC
- +25 if DMCVALID="NO"!(DMCVALID="PENDING")
- SET OUT=1
- +26 ;If DMC Debt Valid is Yes refer to DMC
- +27 if DMCVALID="YES"
- SET OUT=0
- +28 ;Check if Vet is SC 50% to 100% or in Receipt of VA Pension
- +29 SET DMCELIG=+$$DMCELIG^RCDMCUT1(+$GET(DFN))
- +30 ;If DMC Debt Valid is Null & SC 50% to 100% or Receiving VA Pension
- +31 ;refer to DMC
- +32 if DMCVALID=""&(DMCELIG>0)
- Begin DoDot:1
- +33 SET OUT=1
- +34 ;Update DMC Valid Indicator to Pending
- +35 DO UPDTDMC^RCDMCUT1(IEN,"P",1)
- End DoDot:1
- +36 ;If DMC Debt Valid is Null & NOT SC 50%to100% & NOT Receiving VA Pension
- +37 ;don't refer to DMC
- +38 if DMCVALID=""&(DMCELIG'>0)
- SET OUT=0
- +39 QUIT OUT
- +40 ;
- DMCELIG(DFN) ;Checks Bill Debtor SC% and Receipt of VA Pension Values
- +1 ;INPUT:
- +2 ; DFN - Pointer Value to Patient (#2) file
- +3 ;OUTPUT:
- +4 ; Returns 0 if not SC 50% to 100% and not receiving a VA Pension
- +5 ; Returns "1^ SC % ^ VA Pension ^ A&A Benefits ^ Housbound Benefits"
- +6 ; if SC 50% to 100% or Receiving a VA Pension.
- +7 ; Should also consider Vets who are receiving A&A or
- +8 ; Housebound benefits as Receiving VA a VA Pension.
- +9 ; The 2nd piece will be the SC % if SC 50% to 100%.
- +10 ; The 3rd piece will be a 1 if Receiving a VA Pension.
- +11 ; If not SC 50% to 100% or Receiving a VA Pension then
- +12 ; The 4th piece will be the A&A Benefits.
- +13 ; The 5th piece will be the Housebound Benefits.
- +14 ;
- +15 NEW OUT
- +16 ;Protect the VADPT variables to prevent errors with ^RCDMC90 routine
- +17 NEW VAHOW,VAROOT,VAERR,VAEL,VAMB,VADM,VASV,VAPA,VATEST,VAOA,VAINDT,VAIN
- +18 NEW VAIP,VAPD,VARP,VASD,VA,VADMVT
- +19 SET OUT=0
- +20 ;Quit if no DFN passed
- +21 if $GET(DFN)'>0
- QUIT OUT
- +22 ;Get Eligibility Data
- +23 DO ELIG^VADPT
- +24 ;Quit if ^DPT(DFN,0) not defined
- +25 if $GET(VAERR)>0
- QUIT OUT
- +26 ;Get monetary benefit data
- +27 DO MB^VADPT
- +28 ;SERVICE CONNECTED? Field- If SC the SC% returned in the 2nd piece.
- +29 if $PIECE($GET(VAEL(3)),U,2)>49
- SET $PIECE(OUT,U,1)=1
- SET $PIECE(OUT,U,2)=$PIECE(VAEL(3),U,2)
- +30 ;RECEIVING A VA PENSION?
- +31 if $PIECE($GET(VAMB(4)),U,1)>0
- SET $PIECE(OUT,U,1)=1
- SET $PIECE(OUT,U,3)=$PIECE(VAMB(4),U,1)
- +32 if +OUT'>0
- Begin DoDot:1
- +33 ;RECEIVING A&A BENEFITS?
- +34 if $PIECE($GET(VAMB(1)),U,1)>0
- SET $PIECE(OUT,U,1)=1
- SET $PIECE(OUT,U,4)=$PIECE(VAMB(1),U,1)
- +35 ;RECEIVING HOUSEBOUND BENEFITS?
- +36 if $PIECE($GET(VAMB(2)),U,1)>0
- SET $PIECE(OUT,U,1)=1
- SET $PIECE(OUT,U,5)=$PIECE(VAMB(2),U,1)
- End DoDot:1
- +37 DO KVAR^VADPT
- +38 QUIT OUT
- +39 ;
- UPDTDMC(IEN,VAL,DELBY) ;Update the DMC Debt Valid Field
- +1 ;INPUT
- +2 ; IEN - Internal Entry Number of Accounts Receivable (#430) file
- +3 ; VAL - DMC Debt Valid Value ("P", "Y", "N" or "@"),
- +4 ; If "@" pass the field will be deleted
- +5 ; DELBY - Used to delete the "DMC Debt Valid Edited By" field when
- +6 ; updated by the Nightly Background Job
- +7 ;Output
- +8 ; No output
- +9 ;
- +10 NEW DA,DIE,DR,X,Y
- +11 if $GET(IEN)'>0
- QUIT
- +12 if "^Y^N^P^@^"'[(U_$GET(VAL)_U)
- QUIT
- +13 LOCK +^PRCA(430,IEN,12.1):30
- +14 ;Quit if another user is editing this entry
- +15 IF '$TEST
- QUIT
- +16 SET DA=IEN
- +17 SET DIE=430
- +18 SET DR="125////"_VAL
- +19 if $GET(DELBY)>0
- SET DR=DR_";126///@"
- +20 DO ^DIE
- +21 LOCK -^PRCA(430,IEN,12.1)
- +22 QUIT
- +23 ;
- GETDEM(DFN) ; Get data from Patient (#2) file
- +1 ;INPUT:
- +2 ; DFN - Pointer Value to Patient (#2) file
- +3 ;OUTPUT:
- +4 ; DEM^VADPT VADM array as spelled out in PIMS Technical Manual
- +5 ;
- +6 ;Calling routines needs to New or Kill following Variables by calling
- +7 ; D KVAR^VADPT
- +8 ; VADM,VAERR,VA
- +9 ;
- +10 NEW OUT,Y
- +11 SET OUT=0
- +12 ;Quit if no DFN passed
- +13 if $GET(DFN)'>0
- QUIT OUT
- +14 ;Get Demographic Data
- +15 DO DEM^VADPT
- +16 ;Quit if ^DPT(DFN,0) not defined
- +17 if $GET(VAERR)>0
- QUIT OUT
- +18 ;Calls Successful
- +19 SET OUT=1
- +20 QUIT OUT
- +21 ;
- FIRSTPAR(IEN430) ;Check if this is a First Party bill
- +1 ;INPUT
- +2 ; IEN430 - Internal Entry Number for Accounts Receivable File
- +3 ;OUTPUT
- +4 ; Returns a 0 if not First Party Bill
- +5 ; Returns a 1 if First Party Bill
- +6 ;
- +7 NEW FLD,FIRST,IEN340
- +8 ;Set default to zero
- +9 SET FIRST=0
- +10 SET IEN430=+$GET(IEN430)
- +11 ;Get DEBTOR Field Value in Account Receivable File
- +12 SET IEN340=+$PIECE($GET(^PRCA(430,IEN430,0)),U,9)
- +13 ;If .01 field in AR Debtor File points to the Patient file
- +14 ;then this is a First Party Debt
- +15 SET FLD=$PIECE($GET(^RCD(340,IEN340,0)),U,1)
- +16 if FLD["DPT"
- SET FIRST=1_U_$PIECE(FLD,";",1)
- +17 QUIT FIRST
- +18 ;
- GETSERDT(BILLNUM) ; Get most recent Outpatient Date, Inpatient Date and RX Date
- +1 ; from the IB Action (#350) file for the corresponding bill
- +2 ;INPUT
- +3 ; BILLNUM - Bill No. (.01) field in AR (#430) file
- +4 ;OUTPUT
- +5 ; 0 - No data
- +6 ; 1 ^ Outpatient Date ^ Discharge Date ^ RX/Refill Date ^ Status
- +7 NEW OUT,IEN
- +8 SET OUT=0
- SET IEN=0
- +9 ;Quit if a Bill Number wasn't passed
- +10 if $GET(BILLNUM)']""
- QUIT OUT
- +11 FOR
- SET IEN=$ORDER(^IB("ABIL",BILLNUM,IEN))
- if IEN'>0
- QUIT
- Begin DoDot:1
- +12 NEW IBDATA,IENS,DFN,ACTTYPE,RESULT,DTBILLFR,BILGROUP,OPDT,DISCHARG,RXDT,STATUS,RXNUM,RXNAM
- +13 SET IENS=IEN_","
- +14 DO GETS^DIQ(350,IENS,".02;.03;.04;.14","IN","IBDATA")
- +15 SET DFN=$GET(IBDATA(350,IENS,.02,"I"))
- +16 SET ACTTYPE=$GET(IBDATA(350,IENS,.03,"I"))
- +17 SET RESULT=$GET(IBDATA(350,IENS,.04,"I"))
- +18 SET DTBILLFR=$GET(IBDATA(350,IENS,.14,"I"))
- +19 SET STATUS=$$GET1^DIQ(350,IENS,.05)
- +20 ;
- +21 ;Child charge. Need to get Parent Charge
- +22 IF $PIECE(RESULT,":",1)=350
- Begin DoDot:2
- +23 SET IENS=+$PIECE(RESULT,":",2)_","
- +24 ;Quit if the entry is the parent
- +25 if +IENS=IEN
- QUIT
- +26 DO GETS^DIQ(350,IENS,".02;.03;.04;.14","IN","IBDATA")
- +27 SET DFN=$GET(IBDATA(350,IENS,.02,"I"))
- +28 SET ACTTYPE=$GET(IBDATA(350,IENS,.03,"I"))
- +29 SET RESULT=$GET(IBDATA(350,IENS,.04,"I"))
- +30 SET DTBILLFR=$GET(IBDATA(350,IENS,.14,"I"))
- +31 SET STATUS=$$GET1^DIQ(350,IENS,.05)
- End DoDot:2
- +32 if $GET(DFN)']""
- QUIT
- +33 ;
- +34 ;Get Billing Group in the IB Action Type File. If internal Set
- +35 ;Code value is 4, then this is an Outpatient Visit (From STMT^IBRFN1)
- +36 ;and can use Date Billed From for the Outpatient Visit Date
- +37 SET BILGROUP=$$GET1^DIQ(350.1,+ACTTYPE_",",.11,"I")
- +38 ;
- +39 ;Outpatient Event
- +40 IF BILGROUP=4!($PIECE(RESULT,":",1)=44)!($PIECE(RESULT,":",1)=409.68)
- Begin DoDot:2
- +41 IF $PIECE(RESULT,":",1)=44
- SET OPDT=$PIECE($PIECE(RESULT,";",2),":",2)
- +42 IF $PIECE(RESULT,":",1)=409.68
- SET OPDT=$$GET1^DIQ(409.68,+$PIECE(RESULT,":",2)_",",.01,"I")
- +43 IF $GET(OPDT)'>0
- SET OPDT=DTBILLFR
- +44 IF $GET(OPDT)>$PIECE(OUT,U,2)
- SET $PIECE(OUT,U,1)=1
- SET $PIECE(OUT,U,2)=OPDT
- SET $PIECE(OUT,U,5)=STATUS
- End DoDot:2
- QUIT
- +45 ;
- +46 ;Quit if RESULTING FROM field is blank
- +47 if $GET(RESULT)']""
- QUIT
- +48 ;
- +49 ;Inpatient Event
- +50 IF $PIECE(RESULT,":",1)=405!($PIECE(RESULT,":",1)=45)
- Begin DoDot:2
- +51 SET VAIP("E")=$PIECE($PIECE(RESULT,";",1),":",2)
- +52 ;Call to get Inpatient data
- +53 DO IN5^VADPT
- +54 if VAERR>0
- QUIT
- +55 SET DISCHARG=$PIECE($GET(VAIP(17,1)),U,1)
- +56 ;Ensure get most current Discharge Date
- +57 IF DISCHARG>$PIECE(OUT,U,3)
- SET $PIECE(OUT,U,1)=1
- SET $PIECE(OUT,U,3)=DISCHARG
- SET $PIECE(OUT,U,5)=STATUS
- +58 DO KVAR^VADPT
- End DoDot:2
- QUIT
- +59 ;
- +60 ;RX Event
- +61 IF $PIECE(RESULT,":",1)=52
- Begin DoDot:2
- +62 NEW PSOFILE,IENS,FLD
- +63 ;Set up for RX Refills
- +64 IF $PIECE(RESULT,";",2)]""
- Begin DoDot:3
- +65 SET PSOFILE=52.1
- +66 SET IENS=+$PIECE($PIECE(RESULT,";",2),":",2)_","_+$PIECE($PIECE(RESULT,";",1),":",2)_","
- +67 SET RXDT=$$GET1^PSODI(PSOFILE,IENS,.01,"I")
- +68 SET RXNAM="1^TBD"
- SET RXNUM="1^TBD"
- End DoDot:3
- +69 ;Set up for RX Data (No refill)
- +70 IF $PIECE(RESULT,";",2)']""
- Begin DoDot:3
- +71 SET PSOFILE=52
- +72 SET IENS=+$PIECE($PIECE(RESULT,";",1),":",2)_","
- +73 SET RXDT=$$GET1^PSODI(PSOFILE,IENS,1,"I")
- +74 SET RXNUM=$$GET1^PSODI(PSOFILE,IENS,.01,"I")
- +75 SET RXNAM=$$GET1^PSODI(PSOFILE,IENS,6,"E")
- End DoDot:3
- +76 ;Ensure get most current RX/Refill Date
- +77 IF RXDT>$PIECE(OUT,U,4)
- SET $PIECE(OUT,U,1)=1
- SET $PIECE(OUT,U,4)=$PIECE(RXDT,U,2)
- SET $PIECE(OUT,U,5)=STATUS
- SET $PIECE(OUT,U,6)=$PIECE(RXNUM,U,2)
- SET $PIECE(OUT,U,7)=$PIECE(RXNAM,U,2)
- End DoDot:2
- QUIT
- End DoDot:1
- +78 QUIT OUT
- +79 ;