IBTRH5I ;ALB/FA - HCSR Create 278 Request ;18-NOV-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 --------------------------------
; COMQUAL - Dictionary screen for Requester Contact Qualifier fields
; CONTINFO - Retrieves Contact related information
; CRT278 - Allows the user to create a new 278 request for the selected
; entry in the HCSR Response worklist
; PERSON - Determines if the specified Provider is a Person or Non/Person
; PDATA - Retrieves the specified Provider's NPI and taxonomy numbers
; REFDATA - Retrieves the Previous Authorization and Reference Numbers for
; the specified entry.
; REQMISS - Checks for missing required fields in a request
; SEND278 - Prompts the user to send a brief 278 transmission
; SVCTYPE - Dictionary Screen for Service Type 2.03 and 356.2216,.03
; TIMEPDQ - Dictionary Screen for Time Period Qualifier, 4.05
; UDREASN - Dictionary Screen for UMO Denial Reasons
;-----------------------------------------------------------------------------
;
CONTINFO(IBTRIEN,CNARY) ;EP
; Retrieves Contact related information for the specified entry
; Input: IBTRIEN - IEN of the entry to retrieve information from
; Output: CNARY - Array of populated information
N NODE19,QUAL,Z
S NODE19=$G(^IBT(356.22,IBTRIEN,19))
F Z="19.01^2^20","19.02^3^21","19.03^4^22" D
. S QUAL=$$EXTERNAL^DILFD(356.22,$P(Z,"^",1),,$P(NODE19,"^",$P(Z,"^",2)))
. I QUAL'="" S CNARY(QUAL)=$G(^IBT(356.22,IBTRIEN,$P(Z,"^",3)))
Q
;
SEND278() ;EP
; Called from the input template to allow the user to send a brief 278 request
; transmission, continue answering all questions in the template or skip to
; Service level information
; Input: None
; Returns: 0 - User either wants to send a brief 278 or exit the input
; template
; 255 - User tried to field jump
; 1 - User wants to continue entering info
; 1400 - User wants to skip to Service Detail Information
I +$P($G(^IBT(356.22,DA,16,0)),U,4) Q 1 ; data already entered for service lines. don't let them use short cut to send.
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,SEL,XX
S XX="^Y:YES;N:NO;S:SKIP"
S DIR(0)="SAO"_XX,DIR("A")="Send 278 Request w/o Additional Info? "
S XX="Select YES to transmit a basic 278 Request now. Select No to enter"
S XX=XX_" additional data before transmitting the 278 Request. Enter S to"
S XX=XX_" skip to Service Line Detail."
S DIR("?")=XX
D ^DIR
I X?1"^"1.E D JUMPERR^IBTRH5H Q "@260"
S Y=$S($D(DUOUT):0,Y="Y":0,Y="N":"@270",Y="S":"@1400",1:"@270")
Q Y
;
SVCTYPE() ;EP
; Dictionary Screen function called from fields: 2.03 and 356.2216,.03
; Screens some specific entries from 365.013
; Input: DA - IEN of the 356.22 entry being edited
; Y - Internal Value of the user response
; Returns: 1 - Data input by the user is valid, 0 otherwise
N CDE,IEN,IENS
; First Get all of IENS that we want to filter out
F CDE=9,10,13,19,22,30,32,34,41,43,47,48,49,50,51,52,53,55,57,58,59,60,81,89 D
. S IEN=$O(^IBE(365.013,"B",CDE,""))
. S:IEN'="" IENS(IEN)=""
F CDE=90,81,91,92,94,95,96,97,98,99,"A0","A1","A2","A3","A5","A7","A8","AA","AB" D
. S IEN=$O(^IBE(365.013,"B",CDE,""))
. S:IEN'="" IENS(IEN)=""
F CDE="AC","AH","AM","AN","AO","AQ","B2","B3","BA","BH","BI","BJ","BK","BM","BR" D
. S IEN=$O(^IBE(365.013,"B",CDE,""))
. S:IEN'="" IENS(IEN)=""
F CDE="BT","BU","BV","BW","BX","CA","CB","CC","CD","CE","CF","CG","CH","CI" D
. S IEN=$O(^IBE(365.013,"B",CDE,""))
. S:IEN'="" IENS(IEN)=""
F CDE="CJ","CK","CL","CM","CN","CO","CP","DG","DM","DS","GF","GN","UC" D
. S IEN=$O(^IBE(365.013,"B",CDE,""))
. S:IEN'="" IENS(IEN)=""
Q:$D(IENS(Y)) 0
Q 1
;
UDREASN(FIELD) ;EP
; Dictionary Screen function called from fields: 356.2215,.03, 356.2215,.04
; 356.2215,.05, 356.2215,.06.
; Prevents Duplicate UMO Denial Reasons
; Input: FIELD - Field being checked
; DA(1) - IEN of the 356.22 entry being edited
; DA - IEN of the UMO multiple
; Y - Internal Value of the user response
; Returns: 1 - Data input by the user is valid, 0 otherwise
N NDE,RET,Z
S RET=1 ; Assume Valid Input
Q:Y="" 1 ; No value entered
S NDE=$G(^IBT(356.22,DA(1),15,DA,0))
; Make sure there are no duplicates
I FIELD=.03 D Q RET
. F Z=4,5,6 D CHK(Z)
I FIELD=.04 D Q RET
. F Z=3,5,6 D CHK(Z)
I FIELD=.05 D Q RET
. F Z=3,4,6 D CHK(Z)
I FIELD=.06 D Q RET
. F Z=3,4,5 D CHK(Z)
Q RET
;
CHK(NUM) ;
I $P(NDE,"^",NUM)=Y S RET=0 Q
Q
;
TIMEPDQ() ;EP
; Dictionary Screen function called from Time Period Qualifier, fields: 4.05,
; 356.2216/5.05
; Screens some specific entries from 365.015
; Input: DA - IEN of the 356.22 entry being edited
; Y - Internal Value of the user response
; Returns: 1 - Data input by the user is valid, 0 otherwise
N CDE,IEN,IENS
; First Get all of IENS that we want to filter out
F CDE=13,22,23,24,25,28,30,31,32,33,36 D
. S IEN=$O(^IBE(365.015,"B",CDE,""))
. S:IEN'="" IENS(IEN)=""
Q:$D(IENS(Y)) 0
Q 1
;
PDATA(PROV) ; EP
; Retrieves the NPI and Taxonomy codes for the requested Provider
; PROV - Provider to retrieve codes for
; Output: NPI^Taxonomy number
N XX,ZZ
S ZZ=$$PRVDATA^IBTRHLO2(+$P(PROV,";",1),$P($P(PROV,"(",2),",",1))
S XX=$$GTXNMY^IBTRH3(PROV)
S XX=$P(XX,"^",1)_"^"_$P(ZZ,"^",7)
Q XX
;
REFDATA(IBTRIEN) ;EP
; Input: IBTRIEN - IEN of the entry being checked
N REFINFO,RIEN,XX
S XX=$G(^IBT(356.22,IBTRIEN,0)),REFINFO=""
S RIEN=$P(XX,"^",19)
Q REFINFO
;
REQMISS(IBTRIEN,IBEXIT) ;EP
; Checks to see if all required fields in the request
; been answered and the user did not '^' the input template
; Input: IBTRIEN - IEN of the entry being checked
; IBEXIT - 0 if user '^' exited the template, 1 otherwise
; Returns: 0 if all required fields have been entered and no '^' exit
; 1 if missing required fields and/or '^' exit. All missing fields
; will be displayed in a warnings message.
N CTC,IENS,MISSING,XX,YY,YY1,YY2,TYPE
S MISSING=0,IENS=IBTRIEN_","
I $$GET1^DIQ(356.22,IENS,2.01,"I")="" D
. D MISSING("Request Category","Request Category is required and does not have a value entered.")
S CTC=$$GET1^DIQ(356.22,IENS,2.02,"I") I CTC="" D
. D MISSING("Certification Type Code","Certification Type Code is required and does not have a value entered.")
S XX=$O(^IBT(356.22,IBTRIEN,16,0)) ; Check for a service line
I XX="" D
. I $$GET1^DIQ(356.22,IENS,2.03,"I")="" D ; No Service Line and No Service Type
.. D MISSING(2.03,"Service Type is required if no Service Lines were entered.")
. S TYPE=$$GET1^DIQ(356.22,IENS,2.04,"I") I TYPE="" D ; No Service Line(s) and no Facility Type Qualifier
.. D MISSING(2.04,"Service Location Qualifier is required if no Service Lines are entered.")
. I TYPE'="A",$$GET1^DIQ(356.22,IENS,2.05,"I")="" D ; No Service Line(s) and no Facility Type
.. D MISSING(2.05,"Service Location is required if no Service Lines are entered.")
. I TYPE="A" D
.. I $$GET1^DIQ(356.22,IENS,2.06,"I")="" D MISSING(2.06,"Location of Care is required if no Service Lines are entered and Facility Type is 'A'")
.. I $$GET1^DIQ(356.22,IENS,2.07,"I")="" D MISSING(2.07,"Bill Classification is required if no Service Lines are entered and Facility Type is 'A'")
;
D REQMISS^IBTRH5J ;additional required fields checking 12/11/14 JWS
;
; If Home Health Care Information Home Health Start date is entered, then
; Prognosis must be defined and we must have a Principal Diagnosis and Date.
I $$GET1^DIQ(356.22,IENS,10.01,"I")'="" D
. I $$GET1^DIQ(356.22,IENS,2.15,"I")="" D
.. S MISSING=MISSING+1
.. S XX="Prognosis is required if Home Health Start Date is defined."
.. S MISSING("Prognosis")=XX
. I '$D(^IBT(356.22,IBTRIEN,3)) D MISSING("Diagnosis","A Principal Diagnosis and Date must be entered for Home Health Care service.")
; Check for Diagnosis values
I $D(^IBT(356.22,IBTRIEN,3)) D DIAGMISS(IBTRIEN,.MISSING)
; Check for a Procedure on every Service line
I $D(^IBT(356.22,IBTRIEN,16)) D SVCMISS(IBTRIEN,.MISSING)
; Check for Attending Physician line for Inpatient entries
D ATTMISS(IBTRIEN,.MISSING)
; User completed the entire template and no require fields are missing
I IBEXIT,'MISSING Q 0
W !!
I 'IBEXIT D
. W !,*7,"'^' exit from the template has been detected. You must complete"
. W !,"the entire 278 request before sending it. Currently entered information"
. W !,"has been saved. Use the SR action to finish entering data to send the request."
I MISSING D
. W !!,*7,"The following required fields are missing or incorrect:"
. S XX=""
. F D Q:XX=""
.. S XX=$O(MISSING(XX))
.. Q:XX=""
.. I MISSING(XX)="" W !,XX Q
.. N TEXT,XX1
.. D FSTRNG^IBJU1(MISSING(XX),76,.TEXT)
.. S XX1="" F S XX1=$O(TEXT(XX1)) Q:XX1="" W !,TEXT(XX1)
.. ;W !,MISSING(XX)
. I IBEXIT D
.. W !!,"A 278 request cannot be sent with missing required fields."
.. I $G(IBTRENT)=1 W !,"Use the AD action to enter required data" Q
.. W !,"Currently entered information has been saved. Use the SR action to finish"
.. W !,"entering data to send the request."
Q 1
;
DIAGMISS(IBTRIEN,MISSING) ; Checks for Diagnosis information when Home Health
; Start Date been defined
; Input: IBTRIEN - IEN of the entry being checked
; MISSING - Current array and count of missing required fields
; Output: MISSING - Updated array and count of missing required fields
; Note: Only called if the Prognosis code (2.03) has a value
N DXCODE,DXDATE,DXTYPE,XX,YY,XX1,START
S XX=0,START=$O(^IBT(356.22,IBTRIEN,3,0))
F S XX=$O(^IBT(356.22,IBTRIEN,3,XX)) Q:XX'=+XX D
. S DXTYPE=$$GET1^DIQ(356.223,XX_","_IBTRIEN_",",.01,"I")
. S DXCODE=$$GET1^DIQ(356.223,XX_","_IBTRIEN_",",.02,"I")
. S DXDATE=$$GET1^DIQ(356.223,XX_","_IBTRIEN_",",.03,"I")
. I DXTYPE="" D
.. I XX=START,$$GET1^DIQ(356.22,IENS,10.01,"I")'="" S XX1="Diagnosis entry number "_XX_" Diagnosis Type must be defined if Home Health Start Date is defined."
.. E S XX1="Diagnosis entry number "_XX_" Diagnosis Type is required."
.. S MISSING=MISSING+1,MISSING("Diagnosis Type "_XX)=XX1
. I DXCODE="" D
.. I XX=START,$$GET1^DIQ(356.22,IENS,10.01,"I")'="" S XX1="Diagnosis entry number "_XX_" Diagnosis Code must be defined if Home Health Start Date is defined."
.. E S XX1="Diagnosis entry number "_XX_" Diagnosis Code is required."
.. S MISSING=MISSING+1,MISSING("Diagnosis Code "_XX)=XX1
. I DXDATE="",XX=START,$$GET1^DIQ(356.22,IENS,10.01,"I")'="" D
.. S XX1="Diagnosis Date Known must be defined if Home Health Start Date is defined."
.. S MISSING=MISSING+1,MISSING("Diagnosis Date Known "_XX)=XX1
. I DXTYPE'="",DXTYPE'=3,DXTYPE'=7,XX=START,$$GET1^DIQ(356.22,IENS,10.01,"I")'="" D
.. S YY=$$GET1^DIQ(356.223,XX_","_IBTRIEN_",",.01)
.. S XX="Diagnosis Type: '"_YY_"' must be 'Principal Diagnosis'"
.. S MISSING=MISSING+1,MISSING("Diagnosis Type")=XX
Q
;
SVCMISS(IBTRIEN,MISSING) ; Checks for a Procedure code on every Service Line
; Input: IBTRIEN - IEN of the entry being checked
; MISSING - Current array and count of missing required fields
; Output: MISSING - Updated array and count of missing required fields
N PCODE,PTYP,SIEN,XX,YY,TYPE,REV,UNIT,COUNT
S SIEN=0
F D Q:+SIEN=0
. S SIEN=$O(^IBT(356.22,IBTRIEN,16,SIEN))
. Q:+SIEN=0
. S YY="Service Line #"_$$SLINE(IBTRIEN,SIEN)
. S PTYPE=$$GET1^DIQ(356.2216,SIEN_","_IBTRIEN_",",1.01,"I")
. I PTYPE="N4" S PCODE=$$GET1^DIQ(356.2216,SIEN_","_IBTRIEN_",",12.01,"I")
. E S PCODE=$$GET1^DIQ(356.2216,SIEN_","_IBTRIEN_",",1.02,"I")
. S TYPE=$$GET1^DIQ(356.2216,SIEN_","_IBTRIEN_",",1.12,"I")
. S REV=$$GET1^DIQ(356.2216,SIEN_","_IBTRIEN_",",2.06,"I")
. I PTYPE="" D
.. I TYPE="I",REV'="" Q ; for Institutional Lines, Service Line Revenue Code may be used instead of Proc Code
.. S XX=YY_" is missing the Procedure Coding Method"
.. S MISSING=MISSING+1,MISSING(YY_" A")=XX
. I PCODE="" D
.. I TYPE="I",REV'="" Q ; for Institutional Lines, Service Line Revenue Code may be used instead of Proc Code
.. S XX=YY_" is missing the Procedure Code"
.. S MISSING=MISSING+1,MISSING(YY_" B")=XX
. I TYPE'="D" D ;Dental lines do not have Unit Count or Unit Measurement Indicator
.. S UNIT=$$GET1^DIQ(356.2216,SIEN_","_IENS,1.1),COUNT=$$GET1^DIQ(356.2216,SIEN_","_IENS,1.11)
.. I (UNIT=""&(COUNT'=""))!(UNIT'=""&(COUNT="")) D ;If either Unit Measurement Code or Service Unit Count exist, both are required
... I UNIT="" D MISSING(YY_" C",YY_" is missing the Units Count measurement indicator.") Q
... D MISSING(YY_" D",YY_" is missing the Unit Count for the service.")
. S UNIT=$$GET1^DIQ(356.2216,SIEN_","_IENS,5.01),COUNT=$$GET1^DIQ(356.2216,SIEN_","_IENS,5.02)
. I (UNIT=""&(COUNT'=""))!(UNIT'=""&(COUNT="")) D ;If either HCSD Quant Qual or HCSD Serv Unit Count exits, both are required
.. I UNIT="" D MISSING(YY_" E",YY_" is missing the HCSD Quantity Qualifier for this service line.") Q
.. D MISSING(YY_" F",YY_" is missing the HCSD Service Unit Count for this service line.")
. I $$GET1^DIQ(356.2216,SIEN_","_IENS,5.05)="",$$GET1^DIQ(356.2216,SIEN_","_IENS,5.06)'="" D
.. D MISSING(YY_" G",YY_" is missing the HCSD Time Period Qualifier value that describes the HCSD Perdio Count.")
. I $D(^IBT(356.22,IBTRIEN,16,SIEN,4)) D
.. N TOO
.. S TOO=0 F S TOO=$O(^IBT(356.22,IBTRIEN,16,SIEN,4,TOO)) Q:TOO'=+TOO D
... I $$GET1^DIQ(356.22164,TOO_","_SIEN_","_IENS,.01)="" D MISSING(YY_" Tooth "_TOO,YY_" Tooth multiple "_TOO_" is missing the required Tooth Code.")
. I $D(^IBT(356.22,IBTRIEN,16,SIEN,6)) D
.. N AT
.. S AT=0 F S AT=$O(^IBT(356.22,IBTRIEN,16,SIEN,6,AT)) Q:AT'=+AT D
... I $$GET1^DIQ(356.22166,AT_","_SIEN_","_IENS,.01)="" D MISSING(YY_" Attachments .01"_AT,YY_" Attachment multiple "_AT_" is missing the required Report Type Code.")
... I $$GET1^DIQ(356.22166,AT_","_SIEN_","_IENS,.02)="" D MISSING(YY_" Attachments .02"_AT,YY_" Attachment multiple "_AT_" is missing the required Report Transmission Code.")
Q
;
SLINE(IBTRIEN,SIEN) ; Returns the Service line number for a line
; Input: IBTRIEN - IEN of the entry being checked
; SIEN - IEN of the service line being checked
; Returns: Service line number
N CNT,IEN
S (CNT,IEN)=0
F D Q:+IEN=0!(SIEN=IEN)
. S IEN=$O(^IBT(356.22,IBTRIEN,16,IEN))
. Q:+IEN=0
. S CNT=CNT+1
Q CNT
;
ATTMISS(IBTRIEN,MISSING) ; Checks for an Attending Physician multiple for
; inpatient entries
; Input: IBTRIEN - IEN of the entry being checked
; MISSING - Current array and count of missing required fields
; Output: MISSING - Updated array and count of missing required fields
N DXCODE,DXDATE,DXTYPE,FOUND,IEN,XX,YY
Q:$$GET1^DIQ(356.22,IBTRIEN_",",.04,"I")="O" ; Outpatient entry
S (FOUND,IEN)=0
F D Q:+IEN=0!FOUND
. S IEN=$O(^IBT(356.22,IBTRIEN,13,IEN))
. Q:+IEN=0
. S XX=$$GET1^DIQ(356.2213,IEN_","_IBTRIEN_",",.01,"I")
. S XX=$$GET1^DIQ(365.022,XX_",",.01,"I")
. Q:XX'=71
. S:$$GET1^DIQ(356.2213,IEN_","_IBTRIEN_",",.03,"I")'="" FOUND=1
Q:FOUND
;
S XX="Attending Physician must be defined for inpatient entries"
S MISSING=MISSING+1,MISSING("Attending Physician")=XX
Q
;
PERSON(PROV) ;EP
; Checks to see if the specified Provider Type PTYPE is a Person or Non-Person
; Input: PROV - IEN of the Provider
; Output: 1 if PROV is a Person, 2 - Otherwise
N PTYPE,XX
S XX=$P(PROV,";",2) ; What file is it filed in?
I XX="VA(200," Q 1
I XX="DIC(4," Q 2
S XX=$P(PROV,";",1)
S PTYPE=$$GET1^DIQ(355.93,XX_",",.02,"I")
Q:PTYPE=2 1
Q 2
;
CRT278(IBTRIEN) ;EP
; Creates a 278 Request for the selected worklist event
; Input: IBTRIEN - Internal IEN of the selected event
; Output: 278 Request created for the selected worklist event.
; Returns: 1 - if the user exited 'normally', 0 if user '^' exited
N CNARY,DA,DIE,DFN,DR,DTOUT,IBBACK,IBCCAT,IBCERTCD,IBDISDT,IBDXCTR,IBEVDT
N IBEXIT,IBFILT,IBMLN,IBNEW,IBOXYET,IBREQCAT,IBRESP,IBPSTAT,IBSSTYP,IBSTYP,IBTEMP
N IBUPOUT,NODE19,PATLINE,VADM,X,XX,XX2,Y,YY,Z
; New special effects characters
N IOHTS,IOHUP,IOICH,IOIND,IOINH,IOINLOW,IOINORM,IOINSERT,IOIRM0,IOIRM1
N IOKP0,IOKP1,IOPK2,IOPK3,IOKP4,IOKP5,IOREMOVE,IORESET,IORLF,IORVOFF,IORVON
N IOSC,IOSELECT,IOSGR0,IOSMPLX,IOSTBM,IOSWL,IOTBC,IOTBCALL,IOUOFF,IOUON,IOUPAR
S DA=IBTRIEN,DIE=356.22,DR="[IB ADD/EDIT 278]",IBUPOUT=0
S NODE19=$G(^IBT(356.22,IBTRIEN,19))
; Set-up special effects characters (next 3 lines)
D HOME^%ZIS
S X="IORVON;IORVOFF"
D ENS^%ZISS
D FULL^VALM1
; Set up Patient Data line
S DFN=$$GET1^DIQ(356.22,IBTRIEN_",",.02,"I")
S Z=""
I +$G(DFN) D
. D DEM^VADPT
. S PATLINE="Patient: "_$E(VADM(1),1,28),Z=Z_$J("",35-$L(Z))_$P(VADM(2),"^",2)
. S PATLINE=PATLINE_" DOB: "_$P(VADM(3),"^",2)_" AGE: "_VADM(4)
W @IOF
; Set 'in-progress mark'
I $$STATUS^IBTRH2(IBTRIEN)="0" D PRMARK1^IBTRH1(IBTRIEN,"01")
; Set Initial Values
S IBRESP=$P($G(^IBT(356.22,IBTRIEN,0)),"^",18) ; 1 - Created from Response
S IBOXYET=$$OXYET^IBTRH5C(IBTRIEN) ; Oxygen Equip Type 'D' or 'E'
S IBPSTAT=$$GET1^DIQ(356.22,IBTRIEN_",",.04,"I") ; Patient Status of the entry
S IBEVDT=$$GET1^DIQ(356.22,IBTRIEN_",",.07,"I") ; Internal Event Date, which may be a range.
S IBDISDT=$P(IBEVDT,"-",2) ; Grab second "-" piece for Discharge Date.
S IBEVDT=$P(IBEVDT,"-",1) ; Grab first "-" piece for Event Date.
I IBPSTAT="I" D
. I IBDISDT'="" S IBDISDT=$$FMTE^XLFDT(IBDISDT,"5Z") Q
. S IBDISDT=$$GET1^DIQ(356.22,IBTRIEN_",",2.22,"I")
. I IBDISDT'="" S IBDISDT=$$FMTE^XLFDT(IBDISDT,"5Z") Q
. ; Attempt to pull discharge date from Patient Movement file.
. N VAIP
. S VAIP("D")=IBEVDT
. D IN5^VADPT
. S IBDISDT=$G(VAIP(17,1))
. I IBDISDT="" Q
. S IBDISDT=$$FMTE^XLFDT(IBDISDT,"5Z")
S IBEVDT=$$FMTE^XLFDT(IBEVDT,"5Z") ; Format Event Date
K DUOUT
D ^DIE
S XX=$S(IBUPOUT:0,$D(Y):0,1:1) ; Detect '^' exit
I 'XX,"^01^03^"[(U_$$STATUS^IBTRH2(IBTRIEN)_U) D:$$CLRASK^IBTRH5K() CLRENTRY^IBTRH5K(IBTRIEN)
Q XX
;
COMQUAL() ;Function EP for Screening Communication Qualifier fields
; This Function is called from the 356.22 Dictionary Communication Qualifier fields.
; These fields include the following:
; 356.22 - 19.01, 19.02, 19.03
; 356.2213 - .07, .08, .09
; 356.22168 - .07, .08, .09
; Screens some specific entries from 365.021
; Input: DA - IEN of the 356.22 entry being edited
; Y - Internal Value of the user response
; Returns: 1 - Data input by the user is valid, 0 otherwise
N CDE,IEN,IENS
; First Get all of IENS that we want to filter out
F CDE="ED","HP","WP" D
. S IEN=$O(^IBE(365.021,"B",CDE,""))
. S:IEN'="" IENS(IEN)=""
Q:$D(IENS(Y)) 0
Q 1
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRH5I 19777 printed Oct 16, 2024@18:28:53 Page 2
IBTRH5I ;ALB/FA - HCSR Create 278 Request ;18-NOV-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 ; COMQUAL - Dictionary screen for Requester Contact Qualifier fields
+9 ; CONTINFO - Retrieves Contact related information
+10 ; CRT278 - Allows the user to create a new 278 request for the selected
+11 ; entry in the HCSR Response worklist
+12 ; PERSON - Determines if the specified Provider is a Person or Non/Person
+13 ; PDATA - Retrieves the specified Provider's NPI and taxonomy numbers
+14 ; REFDATA - Retrieves the Previous Authorization and Reference Numbers for
+15 ; the specified entry.
+16 ; REQMISS - Checks for missing required fields in a request
+17 ; SEND278 - Prompts the user to send a brief 278 transmission
+18 ; SVCTYPE - Dictionary Screen for Service Type 2.03 and 356.2216,.03
+19 ; TIMEPDQ - Dictionary Screen for Time Period Qualifier, 4.05
+20 ; UDREASN - Dictionary Screen for UMO Denial Reasons
+21 ;-----------------------------------------------------------------------------
+22 ;
CONTINFO(IBTRIEN,CNARY) ;EP
+1 ; Retrieves Contact related information for the specified entry
+2 ; Input: IBTRIEN - IEN of the entry to retrieve information from
+3 ; Output: CNARY - Array of populated information
+4 NEW NODE19,QUAL,Z
+5 SET NODE19=$GET(^IBT(356.22,IBTRIEN,19))
+6 FOR Z="19.01^2^20","19.02^3^21","19.03^4^22"
Begin DoDot:1
+7 SET QUAL=$$EXTERNAL^DILFD(356.22,$PIECE(Z,"^",1),,$PIECE(NODE19,"^",$PIECE(Z,"^",2)))
+8 IF QUAL'=""
SET CNARY(QUAL)=$GET(^IBT(356.22,IBTRIEN,$PIECE(Z,"^",3)))
End DoDot:1
+9 QUIT
+10 ;
SEND278() ;EP
+1 ; Called from the input template to allow the user to send a brief 278 request
+2 ; transmission, continue answering all questions in the template or skip to
+3 ; Service level information
+4 ; Input: None
+5 ; Returns: 0 - User either wants to send a brief 278 or exit the input
+6 ; template
+7 ; 255 - User tried to field jump
+8 ; 1 - User wants to continue entering info
+9 ; 1400 - User wants to skip to Service Detail Information
+10 ; data already entered for service lines. don't let them use short cut to send.
IF +$PIECE($GET(^IBT(356.22,DA,16,0)),U,4)
QUIT 1
+11 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,SEL,XX
+12 SET XX="^Y:YES;N:NO;S:SKIP"
+13 SET DIR(0)="SAO"_XX
SET DIR("A")="Send 278 Request w/o Additional Info? "
+14 SET XX="Select YES to transmit a basic 278 Request now. Select No to enter"
+15 SET XX=XX_" additional data before transmitting the 278 Request. Enter S to"
+16 SET XX=XX_" skip to Service Line Detail."
+17 SET DIR("?")=XX
+18 DO ^DIR
+19 IF X?1"^"1.E
DO JUMPERR^IBTRH5H
QUIT "@260"
+20 SET Y=$SELECT($DATA(DUOUT):0,Y="Y":0,Y="N":"@270",Y="S":"@1400",1:"@270")
+21 QUIT Y
+22 ;
SVCTYPE() ;EP
+1 ; Dictionary Screen function called from fields: 2.03 and 356.2216,.03
+2 ; Screens some specific entries from 365.013
+3 ; Input: DA - IEN of the 356.22 entry being edited
+4 ; Y - Internal Value of the user response
+5 ; Returns: 1 - Data input by the user is valid, 0 otherwise
+6 NEW CDE,IEN,IENS
+7 ; First Get all of IENS that we want to filter out
+8 FOR CDE=9,10,13,19,22,30,32,34,41,43,47,48,49,50,51,52,53,55,57,58,59,60,81,89
Begin DoDot:1
+9 SET IEN=$ORDER(^IBE(365.013,"B",CDE,""))
+10 if IEN'=""
SET IENS(IEN)=""
End DoDot:1
+11 FOR CDE=90,81,91,92,94,95,96,97,98,99,"A0","A1","A2","A3","A5","A7","A8","AA","AB"
Begin DoDot:1
+12 SET IEN=$ORDER(^IBE(365.013,"B",CDE,""))
+13 if IEN'=""
SET IENS(IEN)=""
End DoDot:1
+14 FOR CDE="AC","AH","AM","AN","AO","AQ","B2","B3","BA","BH","BI","BJ","BK","BM","BR"
Begin DoDot:1
+15 SET IEN=$ORDER(^IBE(365.013,"B",CDE,""))
+16 if IEN'=""
SET IENS(IEN)=""
End DoDot:1
+17 FOR CDE="BT","BU","BV","BW","BX","CA","CB","CC","CD","CE","CF","CG","CH","CI"
Begin DoDot:1
+18 SET IEN=$ORDER(^IBE(365.013,"B",CDE,""))
+19 if IEN'=""
SET IENS(IEN)=""
End DoDot:1
+20 FOR CDE="CJ","CK","CL","CM","CN","CO","CP","DG","DM","DS","GF","GN","UC"
Begin DoDot:1
+21 SET IEN=$ORDER(^IBE(365.013,"B",CDE,""))
+22 if IEN'=""
SET IENS(IEN)=""
End DoDot:1
+23 if $DATA(IENS(Y))
QUIT 0
+24 QUIT 1
+25 ;
UDREASN(FIELD) ;EP
+1 ; Dictionary Screen function called from fields: 356.2215,.03, 356.2215,.04
+2 ; 356.2215,.05, 356.2215,.06.
+3 ; Prevents Duplicate UMO Denial Reasons
+4 ; Input: FIELD - Field being checked
+5 ; DA(1) - IEN of the 356.22 entry being edited
+6 ; DA - IEN of the UMO multiple
+7 ; Y - Internal Value of the user response
+8 ; Returns: 1 - Data input by the user is valid, 0 otherwise
+9 NEW NDE,RET,Z
+10 ; Assume Valid Input
SET RET=1
+11 ; No value entered
if Y=""
QUIT 1
+12 SET NDE=$GET(^IBT(356.22,DA(1),15,DA,0))
+13 ; Make sure there are no duplicates
+14 IF FIELD=.03
Begin DoDot:1
+15 FOR Z=4,5,6
DO CHK(Z)
End DoDot:1
QUIT RET
+16 IF FIELD=.04
Begin DoDot:1
+17 FOR Z=3,5,6
DO CHK(Z)
End DoDot:1
QUIT RET
+18 IF FIELD=.05
Begin DoDot:1
+19 FOR Z=3,4,6
DO CHK(Z)
End DoDot:1
QUIT RET
+20 IF FIELD=.06
Begin DoDot:1
+21 FOR Z=3,4,5
DO CHK(Z)
End DoDot:1
QUIT RET
+22 QUIT RET
+23 ;
CHK(NUM) ;
+1 IF $PIECE(NDE,"^",NUM)=Y
SET RET=0
QUIT
+2 QUIT
+3 ;
TIMEPDQ() ;EP
+1 ; Dictionary Screen function called from Time Period Qualifier, fields: 4.05,
+2 ; 356.2216/5.05
+3 ; Screens some specific entries from 365.015
+4 ; Input: DA - IEN of the 356.22 entry being edited
+5 ; Y - Internal Value of the user response
+6 ; Returns: 1 - Data input by the user is valid, 0 otherwise
+7 NEW CDE,IEN,IENS
+8 ; First Get all of IENS that we want to filter out
+9 FOR CDE=13,22,23,24,25,28,30,31,32,33,36
Begin DoDot:1
+10 SET IEN=$ORDER(^IBE(365.015,"B",CDE,""))
+11 if IEN'=""
SET IENS(IEN)=""
End DoDot:1
+12 if $DATA(IENS(Y))
QUIT 0
+13 QUIT 1
+14 ;
PDATA(PROV) ; EP
+1 ; Retrieves the NPI and Taxonomy codes for the requested Provider
+2 ; PROV - Provider to retrieve codes for
+3 ; Output: NPI^Taxonomy number
+4 NEW XX,ZZ
+5 SET ZZ=$$PRVDATA^IBTRHLO2(+$PIECE(PROV,";",1),$PIECE($PIECE(PROV,"(",2),",",1))
+6 SET XX=$$GTXNMY^IBTRH3(PROV)
+7 SET XX=$PIECE(XX,"^",1)_"^"_$PIECE(ZZ,"^",7)
+8 QUIT XX
+9 ;
REFDATA(IBTRIEN) ;EP
+1 ; Input: IBTRIEN - IEN of the entry being checked
+2 NEW REFINFO,RIEN,XX
+3 SET XX=$GET(^IBT(356.22,IBTRIEN,0))
SET REFINFO=""
+4 SET RIEN=$PIECE(XX,"^",19)
+5 QUIT REFINFO
+6 ;
REQMISS(IBTRIEN,IBEXIT) ;EP
+1 ; Checks to see if all required fields in the request
+2 ; been answered and the user did not '^' the input template
+3 ; Input: IBTRIEN - IEN of the entry being checked
+4 ; IBEXIT - 0 if user '^' exited the template, 1 otherwise
+5 ; Returns: 0 if all required fields have been entered and no '^' exit
+6 ; 1 if missing required fields and/or '^' exit. All missing fields
+7 ; will be displayed in a warnings message.
+8 NEW CTC,IENS,MISSING,XX,YY,YY1,YY2,TYPE
+9 SET MISSING=0
SET IENS=IBTRIEN_","
+10 IF $$GET1^DIQ(356.22,IENS,2.01,"I")=""
Begin DoDot:1
+11 DO MISSING("Request Category","Request Category is required and does not have a value entered.")
End DoDot:1
+12 SET CTC=$$GET1^DIQ(356.22,IENS,2.02,"I")
IF CTC=""
Begin DoDot:1
+13 DO MISSING("Certification Type Code","Certification Type Code is required and does not have a value entered.")
End DoDot:1
+14 ; Check for a service line
SET XX=$ORDER(^IBT(356.22,IBTRIEN,16,0))
+15 IF XX=""
Begin DoDot:1
+16 ; No Service Line and No Service Type
IF $$GET1^DIQ(356.22,IENS,2.03,"I")=""
Begin DoDot:2
+17 DO MISSING(2.03,"Service Type is required if no Service Lines were entered.")
End DoDot:2
+18 ; No Service Line(s) and no Facility Type Qualifier
SET TYPE=$$GET1^DIQ(356.22,IENS,2.04,"I")
IF TYPE=""
Begin DoDot:2
+19 DO MISSING(2.04,"Service Location Qualifier is required if no Service Lines are entered.")
End DoDot:2
+20 ; No Service Line(s) and no Facility Type
IF TYPE'="A"
IF $$GET1^DIQ(356.22,IENS,2.05,"I")=""
Begin DoDot:2
+21 DO MISSING(2.05,"Service Location is required if no Service Lines are entered.")
End DoDot:2
+22 IF TYPE="A"
Begin DoDot:2
+23 IF $$GET1^DIQ(356.22,IENS,2.06,"I")=""
DO MISSING(2.06,"Location of Care is required if no Service Lines are entered and Facility Type is 'A'")
+24 IF $$GET1^DIQ(356.22,IENS,2.07,"I")=""
DO MISSING(2.07,"Bill Classification is required if no Service Lines are entered and Facility Type is 'A'")
End DoDot:2
End DoDot:1
+25 ;
+26 ;additional required fields checking 12/11/14 JWS
DO REQMISS^IBTRH5J
+27 ;
+28 ; If Home Health Care Information Home Health Start date is entered, then
+29 ; Prognosis must be defined and we must have a Principal Diagnosis and Date.
+30 IF $$GET1^DIQ(356.22,IENS,10.01,"I")'=""
Begin DoDot:1
+31 IF $$GET1^DIQ(356.22,IENS,2.15,"I")=""
Begin DoDot:2
+32 SET MISSING=MISSING+1
+33 SET XX="Prognosis is required if Home Health Start Date is defined."
+34 SET MISSING("Prognosis")=XX
End DoDot:2
+35 IF '$DATA(^IBT(356.22,IBTRIEN,3))
DO MISSING("Diagnosis","A Principal Diagnosis and Date must be entered for Home Health Care service.")
End DoDot:1
+36 ; Check for Diagnosis values
+37 IF $DATA(^IBT(356.22,IBTRIEN,3))
DO DIAGMISS(IBTRIEN,.MISSING)
+38 ; Check for a Procedure on every Service line
+39 IF $DATA(^IBT(356.22,IBTRIEN,16))
DO SVCMISS(IBTRIEN,.MISSING)
+40 ; Check for Attending Physician line for Inpatient entries
+41 DO ATTMISS(IBTRIEN,.MISSING)
+42 ; User completed the entire template and no require fields are missing
+43 IF IBEXIT
IF 'MISSING
QUIT 0
+44 WRITE !!
+45 IF 'IBEXIT
Begin DoDot:1
+46 WRITE !,*7,"'^' exit from the template has been detected. You must complete"
+47 WRITE !,"the entire 278 request before sending it. Currently entered information"
+48 WRITE !,"has been saved. Use the SR action to finish entering data to send the request."
End DoDot:1
+49 IF MISSING
Begin DoDot:1
+50 WRITE !!,*7,"The following required fields are missing or incorrect:"
+51 SET XX=""
+52 FOR
Begin DoDot:2
+53 SET XX=$ORDER(MISSING(XX))
+54 if XX=""
QUIT
+55 IF MISSING(XX)=""
WRITE !,XX
QUIT
+56 NEW TEXT,XX1
+57 DO FSTRNG^IBJU1(MISSING(XX),76,.TEXT)
+58 SET XX1=""
FOR
SET XX1=$ORDER(TEXT(XX1))
if XX1=""
QUIT
WRITE !,TEXT(XX1)
+59 ;W !,MISSING(XX)
End DoDot:2
if XX=""
QUIT
+60 IF IBEXIT
Begin DoDot:2
+61 WRITE !!,"A 278 request cannot be sent with missing required fields."
+62 IF $GET(IBTRENT)=1
WRITE !,"Use the AD action to enter required data"
QUIT
+63 WRITE !,"Currently entered information has been saved. Use the SR action to finish"
+64 WRITE !,"entering data to send the request."
End DoDot:2
End DoDot:1
+65 QUIT 1
+66 ;
DIAGMISS(IBTRIEN,MISSING) ; Checks for Diagnosis information when Home Health
+1 ; Start Date been defined
+2 ; Input: IBTRIEN - IEN of the entry being checked
+3 ; MISSING - Current array and count of missing required fields
+4 ; Output: MISSING - Updated array and count of missing required fields
+5 ; Note: Only called if the Prognosis code (2.03) has a value
+6 NEW DXCODE,DXDATE,DXTYPE,XX,YY,XX1,START
+7 SET XX=0
SET START=$ORDER(^IBT(356.22,IBTRIEN,3,0))
+8 FOR
SET XX=$ORDER(^IBT(356.22,IBTRIEN,3,XX))
if XX'=+XX
QUIT
Begin DoDot:1
+9 SET DXTYPE=$$GET1^DIQ(356.223,XX_","_IBTRIEN_",",.01,"I")
+10 SET DXCODE=$$GET1^DIQ(356.223,XX_","_IBTRIEN_",",.02,"I")
+11 SET DXDATE=$$GET1^DIQ(356.223,XX_","_IBTRIEN_",",.03,"I")
+12 IF DXTYPE=""
Begin DoDot:2
+13 IF XX=START
IF $$GET1^DIQ(356.22,IENS,10.01,"I")'=""
SET XX1="Diagnosis entry number "_XX_" Diagnosis Type must be defined if Home Health Start Date is defined."
+14 IF '$TEST
SET XX1="Diagnosis entry number "_XX_" Diagnosis Type is required."
+15 SET MISSING=MISSING+1
SET MISSING("Diagnosis Type "_XX)=XX1
End DoDot:2
+16 IF DXCODE=""
Begin DoDot:2
+17 IF XX=START
IF $$GET1^DIQ(356.22,IENS,10.01,"I")'=""
SET XX1="Diagnosis entry number "_XX_" Diagnosis Code must be defined if Home Health Start Date is defined."
+18 IF '$TEST
SET XX1="Diagnosis entry number "_XX_" Diagnosis Code is required."
+19 SET MISSING=MISSING+1
SET MISSING("Diagnosis Code "_XX)=XX1
End DoDot:2
+20 IF DXDATE=""
IF XX=START
IF $$GET1^DIQ(356.22,IENS,10.01,"I")'=""
Begin DoDot:2
+21 SET XX1="Diagnosis Date Known must be defined if Home Health Start Date is defined."
+22 SET MISSING=MISSING+1
SET MISSING("Diagnosis Date Known "_XX)=XX1
End DoDot:2
+23 IF DXTYPE'=""
IF DXTYPE'=3
IF DXTYPE'=7
IF XX=START
IF $$GET1^DIQ(356.22,IENS,10.01,"I")'=""
Begin DoDot:2
+24 SET YY=$$GET1^DIQ(356.223,XX_","_IBTRIEN_",",.01)
+25 SET XX="Diagnosis Type: '"_YY_"' must be 'Principal Diagnosis'"
+26 SET MISSING=MISSING+1
SET MISSING("Diagnosis Type")=XX
End DoDot:2
End DoDot:1
+27 QUIT
+28 ;
SVCMISS(IBTRIEN,MISSING) ; Checks for a Procedure code on every Service Line
+1 ; Input: IBTRIEN - IEN of the entry being checked
+2 ; MISSING - Current array and count of missing required fields
+3 ; Output: MISSING - Updated array and count of missing required fields
+4 NEW PCODE,PTYP,SIEN,XX,YY,TYPE,REV,UNIT,COUNT
+5 SET SIEN=0
+6 FOR
Begin DoDot:1
+7 SET SIEN=$ORDER(^IBT(356.22,IBTRIEN,16,SIEN))
+8 if +SIEN=0
QUIT
+9 SET YY="Service Line #"_$$SLINE(IBTRIEN,SIEN)
+10 SET PTYPE=$$GET1^DIQ(356.2216,SIEN_","_IBTRIEN_",",1.01,"I")
+11 IF PTYPE="N4"
SET PCODE=$$GET1^DIQ(356.2216,SIEN_","_IBTRIEN_",",12.01,"I")
+12 IF '$TEST
SET PCODE=$$GET1^DIQ(356.2216,SIEN_","_IBTRIEN_",",1.02,"I")
+13 SET TYPE=$$GET1^DIQ(356.2216,SIEN_","_IBTRIEN_",",1.12,"I")
+14 SET REV=$$GET1^DIQ(356.2216,SIEN_","_IBTRIEN_",",2.06,"I")
+15 IF PTYPE=""
Begin DoDot:2
+16 ; for Institutional Lines, Service Line Revenue Code may be used instead of Proc Code
IF TYPE="I"
IF REV'=""
QUIT
+17 SET XX=YY_" is missing the Procedure Coding Method"
+18 SET MISSING=MISSING+1
SET MISSING(YY_" A")=XX
End DoDot:2
+19 IF PCODE=""
Begin DoDot:2
+20 ; for Institutional Lines, Service Line Revenue Code may be used instead of Proc Code
IF TYPE="I"
IF REV'=""
QUIT
+21 SET XX=YY_" is missing the Procedure Code"
+22 SET MISSING=MISSING+1
SET MISSING(YY_" B")=XX
End DoDot:2
+23 ;Dental lines do not have Unit Count or Unit Measurement Indicator
IF TYPE'="D"
Begin DoDot:2
+24 SET UNIT=$$GET1^DIQ(356.2216,SIEN_","_IENS,1.1)
SET COUNT=$$GET1^DIQ(356.2216,SIEN_","_IENS,1.11)
+25 ;If either Unit Measurement Code or Service Unit Count exist, both are required
IF (UNIT=""&(COUNT'=""))!(UNIT'=""&(COUNT=""))
Begin DoDot:3
+26 IF UNIT=""
DO MISSING(YY_" C",YY_" is missing the Units Count measurement indicator.")
QUIT
+27 DO MISSING(YY_" D",YY_" is missing the Unit Count for the service.")
End DoDot:3
End DoDot:2
+28 SET UNIT=$$GET1^DIQ(356.2216,SIEN_","_IENS,5.01)
SET COUNT=$$GET1^DIQ(356.2216,SIEN_","_IENS,5.02)
+29 ;If either HCSD Quant Qual or HCSD Serv Unit Count exits, both are required
IF (UNIT=""&(COUNT'=""))!(UNIT'=""&(COUNT=""))
Begin DoDot:2
+30 IF UNIT=""
DO MISSING(YY_" E",YY_" is missing the HCSD Quantity Qualifier for this service line.")
QUIT
+31 DO MISSING(YY_" F",YY_" is missing the HCSD Service Unit Count for this service line.")
End DoDot:2
+32 IF $$GET1^DIQ(356.2216,SIEN_","_IENS,5.05)=""
IF $$GET1^DIQ(356.2216,SIEN_","_IENS,5.06)'=""
Begin DoDot:2
+33 DO MISSING(YY_" G",YY_" is missing the HCSD Time Period Qualifier value that describes the HCSD Perdio Count.")
End DoDot:2
+34 IF $DATA(^IBT(356.22,IBTRIEN,16,SIEN,4))
Begin DoDot:2
+35 NEW TOO
+36 SET TOO=0
FOR
SET TOO=$ORDER(^IBT(356.22,IBTRIEN,16,SIEN,4,TOO))
if TOO'=+TOO
QUIT
Begin DoDot:3
+37 IF $$GET1^DIQ(356.22164,TOO_","_SIEN_","_IENS,.01)=""
DO MISSING(YY_" Tooth "_TOO,YY_" Tooth multiple "_TOO_" is missing the required Tooth Code.")
End DoDot:3
End DoDot:2
+38 IF $DATA(^IBT(356.22,IBTRIEN,16,SIEN,6))
Begin DoDot:2
+39 NEW AT
+40 SET AT=0
FOR
SET AT=$ORDER(^IBT(356.22,IBTRIEN,16,SIEN,6,AT))
if AT'=+AT
QUIT
Begin DoDot:3
+41 IF $$GET1^DIQ(356.22166,AT_","_SIEN_","_IENS,.01)=""
DO MISSING(YY_" Attachments .01"_AT,YY_" Attachment multiple "_AT_" is missing the required Report Type Code.")
+42 IF $$GET1^DIQ(356.22166,AT_","_SIEN_","_IENS,.02)=""
DO MISSING(YY_" Attachments .02"_AT,YY_" Attachment multiple "_AT_" is missing the required Report Transmission Code.")
End DoDot:3
End DoDot:2
End DoDot:1
if +SIEN=0
QUIT
+43 QUIT
+44 ;
SLINE(IBTRIEN,SIEN) ; Returns the Service line number for a line
+1 ; Input: IBTRIEN - IEN of the entry being checked
+2 ; SIEN - IEN of the service line being checked
+3 ; Returns: Service line number
+4 NEW CNT,IEN
+5 SET (CNT,IEN)=0
+6 FOR
Begin DoDot:1
+7 SET IEN=$ORDER(^IBT(356.22,IBTRIEN,16,IEN))
+8 if +IEN=0
QUIT
+9 SET CNT=CNT+1
End DoDot:1
if +IEN=0!(SIEN=IEN)
QUIT
+10 QUIT CNT
+11 ;
ATTMISS(IBTRIEN,MISSING) ; Checks for an Attending Physician multiple for
+1 ; inpatient entries
+2 ; Input: IBTRIEN - IEN of the entry being checked
+3 ; MISSING - Current array and count of missing required fields
+4 ; Output: MISSING - Updated array and count of missing required fields
+5 NEW DXCODE,DXDATE,DXTYPE,FOUND,IEN,XX,YY
+6 ; Outpatient entry
if $$GET1^DIQ(356.22,IBTRIEN_",",.04,"I")="O"
QUIT
+7 SET (FOUND,IEN)=0
+8 FOR
Begin DoDot:1
+9 SET IEN=$ORDER(^IBT(356.22,IBTRIEN,13,IEN))
+10 if +IEN=0
QUIT
+11 SET XX=$$GET1^DIQ(356.2213,IEN_","_IBTRIEN_",",.01,"I")
+12 SET XX=$$GET1^DIQ(365.022,XX_",",.01,"I")
+13 if XX'=71
QUIT
+14 if $$GET1^DIQ(356.2213,IEN_","_IBTRIEN_",",.03,"I")'=""
SET FOUND=1
End DoDot:1
if +IEN=0!FOUND
QUIT
+15 if FOUND
QUIT
+16 ;
+17 SET XX="Attending Physician must be defined for inpatient entries"
+18 SET MISSING=MISSING+1
SET MISSING("Attending Physician")=XX
+19 QUIT
+20 ;
PERSON(PROV) ;EP
+1 ; Checks to see if the specified Provider Type PTYPE is a Person or Non-Person
+2 ; Input: PROV - IEN of the Provider
+3 ; Output: 1 if PROV is a Person, 2 - Otherwise
+4 NEW PTYPE,XX
+5 ; What file is it filed in?
SET XX=$PIECE(PROV,";",2)
+6 IF XX="VA(200,"
QUIT 1
+7 IF XX="DIC(4,"
QUIT 2
+8 SET XX=$PIECE(PROV,";",1)
+9 SET PTYPE=$$GET1^DIQ(355.93,XX_",",.02,"I")
+10 if PTYPE=2
QUIT 1
+11 QUIT 2
+12 ;
CRT278(IBTRIEN) ;EP
+1 ; Creates a 278 Request for the selected worklist event
+2 ; Input: IBTRIEN - Internal IEN of the selected event
+3 ; Output: 278 Request created for the selected worklist event.
+4 ; Returns: 1 - if the user exited 'normally', 0 if user '^' exited
+5 NEW CNARY,DA,DIE,DFN,DR,DTOUT,IBBACK,IBCCAT,IBCERTCD,IBDISDT,IBDXCTR,IBEVDT
+6 NEW IBEXIT,IBFILT,IBMLN,IBNEW,IBOXYET,IBREQCAT,IBRESP,IBPSTAT,IBSSTYP,IBSTYP,IBTEMP
+7 NEW IBUPOUT,NODE19,PATLINE,VADM,X,XX,XX2,Y,YY,Z
+8 ; New special effects characters
+9 NEW IOHTS,IOHUP,IOICH,IOIND,IOINH,IOINLOW,IOINORM,IOINSERT,IOIRM0,IOIRM1
+10 NEW IOKP0,IOKP1,IOPK2,IOPK3,IOKP4,IOKP5,IOREMOVE,IORESET,IORLF,IORVOFF,IORVON
+11 NEW IOSC,IOSELECT,IOSGR0,IOSMPLX,IOSTBM,IOSWL,IOTBC,IOTBCALL,IOUOFF,IOUON,IOUPAR
+12 SET DA=IBTRIEN
SET DIE=356.22
SET DR="[IB ADD/EDIT 278]"
SET IBUPOUT=0
+13 SET NODE19=$GET(^IBT(356.22,IBTRIEN,19))
+14 ; Set-up special effects characters (next 3 lines)
+15 DO HOME^%ZIS
+16 SET X="IORVON;IORVOFF"
+17 DO ENS^%ZISS
+18 DO FULL^VALM1
+19 ; Set up Patient Data line
+20 SET DFN=$$GET1^DIQ(356.22,IBTRIEN_",",.02,"I")
+21 SET Z=""
+22 IF +$GET(DFN)
Begin DoDot:1
+23 DO DEM^VADPT
+24 SET PATLINE="Patient: "_$EXTRACT(VADM(1),1,28)
SET Z=Z_$JUSTIFY("",35-$LENGTH(Z))_$PIECE(VADM(2),"^",2)
+25 SET PATLINE=PATLINE_" DOB: "_$PIECE(VADM(3),"^",2)_" AGE: "_VADM(4)
End DoDot:1
+26 WRITE @IOF
+27 ; Set 'in-progress mark'
+28 IF $$STATUS^IBTRH2(IBTRIEN)="0"
DO PRMARK1^IBTRH1(IBTRIEN,"01")
+29 ; Set Initial Values
+30 ; 1 - Created from Response
SET IBRESP=$PIECE($GET(^IBT(356.22,IBTRIEN,0)),"^",18)
+31 ; Oxygen Equip Type 'D' or 'E'
SET IBOXYET=$$OXYET^IBTRH5C(IBTRIEN)
+32 ; Patient Status of the entry
SET IBPSTAT=$$GET1^DIQ(356.22,IBTRIEN_",",.04,"I")
+33 ; Internal Event Date, which may be a range.
SET IBEVDT=$$GET1^DIQ(356.22,IBTRIEN_",",.07,"I")
+34 ; Grab second "-" piece for Discharge Date.
SET IBDISDT=$PIECE(IBEVDT,"-",2)
+35 ; Grab first "-" piece for Event Date.
SET IBEVDT=$PIECE(IBEVDT,"-",1)
+36 IF IBPSTAT="I"
Begin DoDot:1
+37 IF IBDISDT'=""
SET IBDISDT=$$FMTE^XLFDT(IBDISDT,"5Z")
QUIT
+38 SET IBDISDT=$$GET1^DIQ(356.22,IBTRIEN_",",2.22,"I")
+39 IF IBDISDT'=""
SET IBDISDT=$$FMTE^XLFDT(IBDISDT,"5Z")
QUIT
+40 ; Attempt to pull discharge date from Patient Movement file.
+41 NEW VAIP
+42 SET VAIP("D")=IBEVDT
+43 DO IN5^VADPT
+44 SET IBDISDT=$GET(VAIP(17,1))
+45 IF IBDISDT=""
QUIT
+46 SET IBDISDT=$$FMTE^XLFDT(IBDISDT,"5Z")
End DoDot:1
+47 ; Format Event Date
SET IBEVDT=$$FMTE^XLFDT(IBEVDT,"5Z")
+48 KILL DUOUT
+49 DO ^DIE
+50 ; Detect '^' exit
SET XX=$SELECT(IBUPOUT:0,$DATA(Y):0,1:1)
+51 IF 'XX
IF "^01^03^"[(U_$$STATUS^IBTRH2(IBTRIEN)_U)
if $$CLRASK^IBTRH5K()
DO CLRENTRY^IBTRH5K(IBTRIEN)
+52 QUIT XX
+53 ;
COMQUAL() ;Function EP for Screening Communication Qualifier fields
+1 ; This Function is called from the 356.22 Dictionary Communication Qualifier fields.
+2 ; These fields include the following:
+3 ; 356.22 - 19.01, 19.02, 19.03
+4 ; 356.2213 - .07, .08, .09
+5 ; 356.22168 - .07, .08, .09
+6 ; Screens some specific entries from 365.021
+7 ; Input: DA - IEN of the 356.22 entry being edited
+8 ; Y - Internal Value of the user response
+9 ; Returns: 1 - Data input by the user is valid, 0 otherwise
+10 NEW CDE,IEN,IENS
+11 ; First Get all of IENS that we want to filter out
+12 FOR CDE="ED","HP","WP"
Begin DoDot:1
+13 SET IEN=$ORDER(^IBE(365.021,"B",CDE,""))
+14 if IEN'=""
SET IENS(IEN)=""
End DoDot:1
+15 if $DATA(IENS(Y))
QUIT 0
+16 QUIT 1
+17 ;
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
