IBTRH5K ;ALB/JWS - HCSR Create 278 Request ;11-DEC-2014
;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
;;Per VA Directive 6402, this routine should not be modified.
;;
; Contains Entry points and functions used in creating a 278 request from a
; selected entry in the HCSR Response worklist
;
; -------------------------- Entry Points --------------------------------
; REQMISS - Checks for missing required fields in a request
;-----------------------------------------------------------------------------
Q
;
REQMISS ; Additional required field checking for 278 transaction
; Input: CTC - Certification Type Code IEN
; IENS - IEN_"," of the entry being checked
; IBTRIEN - IEN of the entry being checked
; MISSING() - Current array of missing fields
; Output: MISSING() - Updated array of missing fields
;
; Check Attachments multiple 356.2211
N CNT,COMN,COMQ,RTC,ZZ
S XX=$O(^IBT(356.22,IBTRIEN,11,0))
I XX D
. S (XX,CNT)=0
. F S XX=$O(^IBT(356.22,IBTRIEN,11,XX)) Q:XX'=+XX D
. . S CNT=CNT+1
. . I $$GET1^DIQ(356.2211,XX_","_IENS,.01)="" D
. . . S ZZ="The Report Type Code is required for all Attachment entries"
. . . D MISSING("Attachment Multiple "_CNT_" Report Type Code",ZZ)
. . S RTC=$$GET1^DIQ(356.2211,XX_","_IENS,.02,"I")
. . I RTC="" D
. . . S ZZ="The Report Transmission Code is required for all Attachment entries"
. . . D MISSING("Attachment Multiple "_XX_" Report Trans Code",ZZ)
. . I $$GET1^DIQ(356.2211,XX_","_IENS,.03)="" D
. . . I $F(",BM,EL,EM,FX,",","_RTC_",") D
. . . . S ZZ="The Attachment Control Number is required for any Attachment "
. . . . S ZZ=ZZ_"entries with a Transmission Code of 'By Mail', 'Electronically Only', 'E-mail', or 'Fax'."
. . . . D MISSING("Attachment Multiple "_XX_" CTL #",ZZ)
;
; Check Patient Event Provider multiple
I '$D(^IBT(356.22,IBTRIEN,13)) D
. I $$GET1^DIQ(356.22,IENS,2.01,"I")=1!('$O(^IBT(356.22,IBTRIEN,16,0))) D Q
. . S ZZ="There must be at least one Patient Event Service Provider included "
. . S ZZ=ZZ_"in a 278 Request with Request Category equal to Admission Review "
. . S ZZ=ZZ_"or with no Service Line detail entered."
. . D MISSING("Patient Event Provider Multiple",ZZ)
. S XX=0
. F S XX=$O(^IBT(356.22,IBTRIEN,16,XX)) Q:XX'=+XX I '$O(^IBT(356.22,IBTRIEN,16,XX,8,0)) S XX="BAD" Q
. S ZZ="There must be at least one Patient Event Service Provider included in "
. S ZZ=ZZ_"a 278 Request if a Service Detail Line does not have a Service Provider entered."
. I XX="BAD" D MISSING("Patient Event Provider Multiple",ZZ)
;
; Check Patient Event Transport multiple
I $D(^IBT(356.22,IBTRIEN,14)) D
. N CNT,CT,ZZ
. S (CNT,XX,CT)=0
. F S XX=$O(^IBT(356.22,IBTRIEN,14,XX)) Q:XX'=+XX D
. . S CNT=CNT+1
. . S CT=$G(CT)+1,CT(CT)=$$GET1^DIQ(356.2214,XX_","_IENS,.01,"I"),CT(CT(CT))=CT
. . I CT(CT)="" D
. . . S ZZ="Patient Event Transport multiple entry "_CNT_" is missing a required Location Type."
. . . D MISSING("Patient Event Trans "_CNT_" .01",ZZ)
. . I $$GET1^DIQ(356.2214,XX_","_IENS,.03)="" D
. . . S ZZ="Patient Event Transport multiple entry "_CNT_" is missing a required Address Line."
. . . D MISSING("Patient Event Trans "_CNT_" .03",ZZ)
. . I $$GET1^DIQ(356.2214,XX_","_IENS,.07)="" D
. . . N CITY,ST
. . . S CITY=$$GET1^DIQ(356.2214,XX_","_IENS,.05)
. . . I CITY="" D
. . . . S ZZ="Patient Event Transport multiple entry "_CNT_" is missing a required City."
. . . . D MISSING("Patient Event Trans "_CNT_" .05",ZZ)
. . . S ST=$$GET1^DIQ(356.2214,XX_","_IENS,.06)
. . . I ST="" D
. . . . S ZZ="Patient Event Transport multiple entry "_CNT_" is missing a required State/Province Code."
. . . . D MISSING("Patient Event Trans "_CNT_" .06",ZZ)
. . . I ST="",CITY="" D
. . . . S ZZ="Patient Event Transport multiple "_CNT_" must have a Zip code entered if no City "
. . . . S ZZ=ZZ_"and State are entered."
. . . . D MISSING("Patient Event Trans "_CNT_" .07",ZZ)
. I CT=1 D
. . S ZZ="There must be at least 2 entries in the Patient Event Transport multiple "
. . S ZZ=ZZ_"indicating the pickup address and the final destination address."
. . D MISSING("Patient Event Transport Multiple",ZZ)
. I CT=2,'$D(CT("PW")),'$D(CT("FS")) D
. . S ZZ="For the Patient Event Transport multiple, if there are 2 entries, one "
. . S ZZ=ZZ_"must be for the Pickup address and the other must be the Final scheduled destination."
. . D MISSING("Patient Event Transport Multiple",ZZ)
;
; Check OTHER UMO multiple
I $D(^IBT(356.22,IBTRIEN,15)) D
. N CNT,ZZ
. S (CNT,XX)=0
. F S XX=$O(^IBT(356.22,IBTRIEN,15,XX)) Q:XX'=+XX D
. . S CNT=CNT+1
. . I $$GET1^DIQ(356.2215,XX_","_IENS,.01)="" D
. . . S ZZ="Other UMO entry "_CNT_" must have a UMO Entity Identifier code."
. . . D MISSING("Other UMO multiple entry "_CNT_" .01",ZZ)
. . I $$GET1^DIQ(356.2215,XX_","_IENS,.03)="" D
. . . S ZZ="Other UMO entry "_CNT_" must have an Other UMO Denial Reason."
. . . D MISSING("Other UMO multiple entry "_CNT_" .03",ZZ)
. . I $$GET1^DIQ(356.2215,XX_","_IENS,.07)="" D
. . . S ZZ="Other UMO entry "_CNT_" must have a UMO Denial Date entered."
. . . D MISSING("Other UMO multiple entry "_CNT_" .07",ZZ)
;
; Check Service Line multiples
I $D(^IBT(356.22,IBTRIEN,16)) D
. N CNT,XX,YY,ZZ,I
. S (CNT,YY,XX)=0
. F S XX=$O(^IBT(356.22,IBTRIEN,16,XX)) Q:XX'=+XX D
. . S CNT=CNT+1
. . I $$GET1^DIQ(356.2216,XX_","_IENS,.15)="" D
. . . F I=.02,.03,.04,.05 I $$GET1^DIQ(356.2216,XX_","_IENS,I)'="" S YY=1 Q
. . . S ZZ="Service Line "_CNT_" requires the UMO Type to be included with service line information."
. . . I YY D MISSING("Service Line "_CNT_" .15",ZZ)
Q
;
;
MISSING(SUB,DESC) ; Function to generate MISSING array
; Input: SUB - subscript of MISSING array
; DESC - description of error condition
; Returns: MISSING array
;
S MISSING=MISSING+1
S MISSING(SUB)=DESC
Q
;
CLRENTRY(IBTRIEN) ; clear an entry in file 356.22
; clears all fields except for .01 - .11, .16, and 4.01 - 4.02 at the top level
; IBTRIEN - file 356.22 ien
;
N FDA,Z,Z1
; top level
F Z=.12:.01:.15,.17:.01:.25,2.01:.01:2.26,4.03:.01:4.14,5.01:.01:5.18 S FDA(356.22,IBTRIEN_",",Z)="@"
F Z=6.01:.01:6.18,7.01:.01:7.13,8.01:.01:8.08,9.01:.01:9.08,10.01:.01:10.13 S FDA(356.22,IBTRIEN_",",Z)="@"
F Z=12,17.01,17.02,18.01:.01:18.1,19:.01:19.03,20:1:23,103.01:.01:103.04 S FDA(356.22,IBTRIEN_",",Z)="@"
; multiples
F Z=1,3,11,13,14,15,16,101,105,107 D
.S Z1=0 F S Z1=$O(^IBT(356.22,IBTRIEN,Z,Z1)) Q:'Z1 S FDA(356.22_Z,Z1_","_IBTRIEN_",",.01)="@"
.Q
D FILE^DIE(,"FDA")
Q
;
CLRASK() ; prompt user for clearing the entry in file 356.22
; returns 1 if entry should be cleared, 0 otherwise
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR("A")="Clear existing data? (Y/N): ",DIR("B")="Y",DIR(0)="YAO" D ^DIR
I $G(DTOUT)!$G(DUOUT)!$G(DIROUT)!($G(Y)'=1) Q 0
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRH5K 7020 printed Oct 16, 2024@18:28:55 Page 2
IBTRH5K ;ALB/JWS - HCSR Create 278 Request ;11-DEC-2014
+1 ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;
+4 ; Contains Entry points and functions used in creating a 278 request from a
+5 ; selected entry in the HCSR Response worklist
+6 ;
+7 ; -------------------------- Entry Points --------------------------------
+8 ; REQMISS - Checks for missing required fields in a request
+9 ;-----------------------------------------------------------------------------
+10 QUIT
+11 ;
REQMISS ; Additional required field checking for 278 transaction
+1 ; Input: CTC - Certification Type Code IEN
+2 ; IENS - IEN_"," of the entry being checked
+3 ; IBTRIEN - IEN of the entry being checked
+4 ; MISSING() - Current array of missing fields
+5 ; Output: MISSING() - Updated array of missing fields
+6 ;
+7 ; Check Attachments multiple 356.2211
+8 NEW CNT,COMN,COMQ,RTC,ZZ
+9 SET XX=$ORDER(^IBT(356.22,IBTRIEN,11,0))
+10 IF XX
Begin DoDot:1
+11 SET (XX,CNT)=0
+12 FOR
SET XX=$ORDER(^IBT(356.22,IBTRIEN,11,XX))
if XX'=+XX
QUIT
Begin DoDot:2
+13 SET CNT=CNT+1
+14 IF $$GET1^DIQ(356.2211,XX_","_IENS,.01)=""
Begin DoDot:3
+15 SET ZZ="The Report Type Code is required for all Attachment entries"
+16 DO MISSING("Attachment Multiple "_CNT_" Report Type Code",ZZ)
End DoDot:3
+17 SET RTC=$$GET1^DIQ(356.2211,XX_","_IENS,.02,"I")
+18 IF RTC=""
Begin DoDot:3
+19 SET ZZ="The Report Transmission Code is required for all Attachment entries"
+20 DO MISSING("Attachment Multiple "_XX_" Report Trans Code",ZZ)
End DoDot:3
+21 IF $$GET1^DIQ(356.2211,XX_","_IENS,.03)=""
Begin DoDot:3
+22 IF $FIND(",BM,EL,EM,FX,",","_RTC_",")
Begin DoDot:4
+23 SET ZZ="The Attachment Control Number is required for any Attachment "
+24 SET ZZ=ZZ_"entries with a Transmission Code of 'By Mail', 'Electronically Only', 'E-mail', or 'Fax'."
+25 DO MISSING("Attachment Multiple "_XX_" CTL #",ZZ)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+26 ;
+27 ; Check Patient Event Provider multiple
+28 IF '$DATA(^IBT(356.22,IBTRIEN,13))
Begin DoDot:1
+29 IF $$GET1^DIQ(356.22,IENS,2.01,"I")=1!('$ORDER(^IBT(356.22,IBTRIEN,16,0)))
Begin DoDot:2
+30 SET ZZ="There must be at least one Patient Event Service Provider included "
+31 SET ZZ=ZZ_"in a 278 Request with Request Category equal to Admission Review "
+32 SET ZZ=ZZ_"or with no Service Line detail entered."
+33 DO MISSING("Patient Event Provider Multiple",ZZ)
End DoDot:2
QUIT
+34 SET XX=0
+35 FOR
SET XX=$ORDER(^IBT(356.22,IBTRIEN,16,XX))
if XX'=+XX
QUIT
IF '$ORDER(^IBT(356.22,IBTRIEN,16,XX,8,0))
SET XX="BAD"
QUIT
+36 SET ZZ="There must be at least one Patient Event Service Provider included in "
+37 SET ZZ=ZZ_"a 278 Request if a Service Detail Line does not have a Service Provider entered."
+38 IF XX="BAD"
DO MISSING("Patient Event Provider Multiple",ZZ)
End DoDot:1
+39 ;
+40 ; Check Patient Event Transport multiple
+41 IF $DATA(^IBT(356.22,IBTRIEN,14))
Begin DoDot:1
+42 NEW CNT,CT,ZZ
+43 SET (CNT,XX,CT)=0
+44 FOR
SET XX=$ORDER(^IBT(356.22,IBTRIEN,14,XX))
if XX'=+XX
QUIT
Begin DoDot:2
+45 SET CNT=CNT+1
+46 SET CT=$GET(CT)+1
SET CT(CT)=$$GET1^DIQ(356.2214,XX_","_IENS,.01,"I")
SET CT(CT(CT))=CT
+47 IF CT(CT)=""
Begin DoDot:3
+48 SET ZZ="Patient Event Transport multiple entry "_CNT_" is missing a required Location Type."
+49 DO MISSING("Patient Event Trans "_CNT_" .01",ZZ)
End DoDot:3
+50 IF $$GET1^DIQ(356.2214,XX_","_IENS,.03)=""
Begin DoDot:3
+51 SET ZZ="Patient Event Transport multiple entry "_CNT_" is missing a required Address Line."
+52 DO MISSING("Patient Event Trans "_CNT_" .03",ZZ)
End DoDot:3
+53 IF $$GET1^DIQ(356.2214,XX_","_IENS,.07)=""
Begin DoDot:3
+54 NEW CITY,ST
+55 SET CITY=$$GET1^DIQ(356.2214,XX_","_IENS,.05)
+56 IF CITY=""
Begin DoDot:4
+57 SET ZZ="Patient Event Transport multiple entry "_CNT_" is missing a required City."
+58 DO MISSING("Patient Event Trans "_CNT_" .05",ZZ)
End DoDot:4
+59 SET ST=$$GET1^DIQ(356.2214,XX_","_IENS,.06)
+60 IF ST=""
Begin DoDot:4
+61 SET ZZ="Patient Event Transport multiple entry "_CNT_" is missing a required State/Province Code."
+62 DO MISSING("Patient Event Trans "_CNT_" .06",ZZ)
End DoDot:4
+63 IF ST=""
IF CITY=""
Begin DoDot:4
+64 SET ZZ="Patient Event Transport multiple "_CNT_" must have a Zip code entered if no City "
+65 SET ZZ=ZZ_"and State are entered."
+66 DO MISSING("Patient Event Trans "_CNT_" .07",ZZ)
End DoDot:4
End DoDot:3
End DoDot:2
+67 IF CT=1
Begin DoDot:2
+68 SET ZZ="There must be at least 2 entries in the Patient Event Transport multiple "
+69 SET ZZ=ZZ_"indicating the pickup address and the final destination address."
+70 DO MISSING("Patient Event Transport Multiple",ZZ)
End DoDot:2
+71 IF CT=2
IF '$DATA(CT("PW"))
IF '$DATA(CT("FS"))
Begin DoDot:2
+72 SET ZZ="For the Patient Event Transport multiple, if there are 2 entries, one "
+73 SET ZZ=ZZ_"must be for the Pickup address and the other must be the Final scheduled destination."
+74 DO MISSING("Patient Event Transport Multiple",ZZ)
End DoDot:2
End DoDot:1
+75 ;
+76 ; Check OTHER UMO multiple
+77 IF $DATA(^IBT(356.22,IBTRIEN,15))
Begin DoDot:1
+78 NEW CNT,ZZ
+79 SET (CNT,XX)=0
+80 FOR
SET XX=$ORDER(^IBT(356.22,IBTRIEN,15,XX))
if XX'=+XX
QUIT
Begin DoDot:2
+81 SET CNT=CNT+1
+82 IF $$GET1^DIQ(356.2215,XX_","_IENS,.01)=""
Begin DoDot:3
+83 SET ZZ="Other UMO entry "_CNT_" must have a UMO Entity Identifier code."
+84 DO MISSING("Other UMO multiple entry "_CNT_" .01",ZZ)
End DoDot:3
+85 IF $$GET1^DIQ(356.2215,XX_","_IENS,.03)=""
Begin DoDot:3
+86 SET ZZ="Other UMO entry "_CNT_" must have an Other UMO Denial Reason."
+87 DO MISSING("Other UMO multiple entry "_CNT_" .03",ZZ)
End DoDot:3
+88 IF $$GET1^DIQ(356.2215,XX_","_IENS,.07)=""
Begin DoDot:3
+89 SET ZZ="Other UMO entry "_CNT_" must have a UMO Denial Date entered."
+90 DO MISSING("Other UMO multiple entry "_CNT_" .07",ZZ)
End DoDot:3
End DoDot:2
End DoDot:1
+91 ;
+92 ; Check Service Line multiples
+93 IF $DATA(^IBT(356.22,IBTRIEN,16))
Begin DoDot:1
+94 NEW CNT,XX,YY,ZZ,I
+95 SET (CNT,YY,XX)=0
+96 FOR
SET XX=$ORDER(^IBT(356.22,IBTRIEN,16,XX))
if XX'=+XX
QUIT
Begin DoDot:2
+97 SET CNT=CNT+1
+98 IF $$GET1^DIQ(356.2216,XX_","_IENS,.15)=""
Begin DoDot:3
+99 FOR I=.02,.03,.04,.05
IF $$GET1^DIQ(356.2216,XX_","_IENS,I)'=""
SET YY=1
QUIT
+100 SET ZZ="Service Line "_CNT_" requires the UMO Type to be included with service line information."
+101 IF YY
DO MISSING("Service Line "_CNT_" .15",ZZ)
End DoDot:3
End DoDot:2
End DoDot:1
+102 QUIT
+103 ;
+104 ;
MISSING(SUB,DESC) ; Function to generate MISSING array
+1 ; Input: SUB - subscript of MISSING array
+2 ; DESC - description of error condition
+3 ; Returns: MISSING array
+4 ;
+5 SET MISSING=MISSING+1
+6 SET MISSING(SUB)=DESC
+7 QUIT
+8 ;
CLRENTRY(IBTRIEN) ; clear an entry in file 356.22
+1 ; clears all fields except for .01 - .11, .16, and 4.01 - 4.02 at the top level
+2 ; IBTRIEN - file 356.22 ien
+3 ;
+4 NEW FDA,Z,Z1
+5 ; top level
+6 FOR Z=.12:.01:.15,.17:.01:.25,2.01:.01:2.26,4.03:.01:4.14,5.01:.01:5.18
SET FDA(356.22,IBTRIEN_",",Z)="@"
+7 FOR Z=6.01:.01:6.18,7.01:.01:7.13,8.01:.01:8.08,9.01:.01:9.08,10.01:.01:10.13
SET FDA(356.22,IBTRIEN_",",Z)="@"
+8 FOR Z=12,17.01,17.02,18.01:.01:18.1,19:.01:19.03,20:1:23,103.01:.01:103.04
SET FDA(356.22,IBTRIEN_",",Z)="@"
+9 ; multiples
+10 FOR Z=1,3,11,13,14,15,16,101,105,107
Begin DoDot:1
+11 SET Z1=0
FOR
SET Z1=$ORDER(^IBT(356.22,IBTRIEN,Z,Z1))
if 'Z1
QUIT
SET FDA(356.22_Z,Z1_","_IBTRIEN_",",.01)="@"
+12 QUIT
End DoDot:1
+13 DO FILE^DIE(,"FDA")
+14 QUIT
+15 ;
CLRASK() ; prompt user for clearing the entry in file 356.22
+1 ; returns 1 if entry should be cleared, 0 otherwise
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+3 SET DIR("A")="Clear existing data? (Y/N): "
SET DIR("B")="Y"
SET DIR(0)="YAO"
DO ^DIR
+4 IF $GET(DTOUT)!$GET(DUOUT)!$GET(DIROUT)!($GET(Y)'=1)
QUIT 0
+5 QUIT 1
