- IBTRH6 ;ALB/FA - HCSR Send 278 Short Worklist ;11-NOV-2014
- ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
- ;;Per VA Directive 6402, this routine should not be modified.
- ;;
- ;
- EN ; Main entry point for the IBT HCSR SEND 278 SHORT worklist
- ; Displays the selected 278 short form for sending 278 requests
- ; Input: IBTRIEN - IEN of the selected entry to send a request for
- N FROMDATA,IBTRENT,INPAT,NODE2,NODE7,NODE19,VADM,WHICH
- ;;12/9/14 JWS - prevent entry if status is PENDING a response
- I $$STATUS^IBTRH2(IBTRIEN)="07" D STATMSG^IBTRH2A(4) Q
- S VALMBCK="R"
- S FROMDATA=0
- S INPAT=$S($P(NODE0,U,4)="I":1,1:0) ; 1 if inpatient, 0 if outpatient
- S WHICH=$$SELSHORT(INPAT) ; type of request
- I WHICH'="" D EN^VALM("IBT HCSR SEND 278 SHORT")
- I $D(IBFASTXT) S VALMBCK="Q"
- Q
- ;
- SELSHORT(INPAT) ; User selection of which 278 request to send
- ; Input: INPAT=1 if inpatient, 0 otherwise
- ; Returns: Selected Input Type or "" if none selected
- N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,XX,Y
- D FULL^VALM1
- I INPAT S XX="1:Admission (initial);2:Mental Health Inpatient (initial)"
- I 'INPAT S XX="1:Appointment (initial);2:Mental Health Outpatient (initial)"
- S XX=XX_";3:Prescription (initial)"
- S DIR(0)="S^"_XX,DIR("A")="Select Input Type"
- D ^DIR
- Q:$D(DIRUT) "" ; User Pressed ^ or timed out
- I Y'=1 D S Y=""
- . W !,"Mental Health and Prescription options are not currently available."
- . N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
- . S DIR(0)="EA"
- . S DIR("A",1)=" "
- . S DIR("A")="Press RETURN to continue " D ^DIR
- Q Y
- ;
- HDR ;EP
- ; Protocol action to display Worklist Patient header information
- ; Input: IBTRIEN - IEN of the selected entry to send a request for
- ; Output: Header information for the patient of the selected entry is set
- ;
- N Z
- S Z=$E(VADM(1),1,28),Z=Z_$J("",35-$L(Z))_$P(VADM(2),U,2)_" DOB: "_$P(VADM(3),U,2)_" AGE: "_VADM(4)
- S VALMHDR(1)=Z
- S VALMSG="*/Required"
- Q
- ;
- INIT ;EP
- ;
- K ^TMP("IBTRH6",$J)
- S VALMBG=1
- D DEM^VADPT ; get patient demographics
- S NODE0=$G(^IBT(356.22,IBTRIEN,0))
- S NODE2=$G(^IBT(356.22,IBTRIEN,2))
- S NODE7=$G(^IBT(356.22,IBTRIEN,7))
- S NODE19=$G(^IBT(356.22,IBTRIEN,19))
- D WRTFLDS D:'FROMDATA WRTCNUM ; auto populate fields
- ; re-read nodes to get auto-populated values
- S NODE0=$G(^IBT(356.22,IBTRIEN,0))
- S NODE2=$G(^IBT(356.22,IBTRIEN,2))
- S NODE7=$G(^IBT(356.22,IBTRIEN,7))
- S NODE19=$G(^IBT(356.22,IBTRIEN,19))
- D BLD
- I WHICH=1 S VALM("TITLE")="HCSR 278 "_$S(INPAT:"Admission",1:"Appointment")_" - Brief"
- I WHICH=2 S VALM("TITLE")="HCSR 278 Mental - Brief"
- I WHICH=3 S VALM("TITLE")="HCSR 278 Prescription - Brief"
- Q
- ;
- BLD ; Creates the body of the worklist
- ;
- N ELINEL,ELINER,SLINE
- S SLINE=1
- D BLDUMO(SLINE,.ELINEL) ; Build UMO Field section
- D BLDSUB(ELINEL,.ELINEL) ; Build Subscriber Field section
- D BLDREQ(SLINE,.ELINER) ; Build Requester Field section
- S SLINE=$S(ELINEL>ELINER:ELINEL,1:ELINER)
- D BLDDEP(SLINE,.ELINEL) ; Build Dependent Field section
- D BLDDIAG(SLINE,.ELINER) ; Build Diagnoses Field section
- S SLINE=$S(ELINEL>ELINER:ELINEL,1:ELINER)
- D BLDHCSR(SLINE,.ELINEL) ; Build Health Care Services Field section
- D BLDPROV(SLINE,.ELINER) ; Build Provider Field section
- S SLINE=$S(ELINEL>ELINER:ELINEL,1:ELINER)
- D BLDSVC(SLINE,.ELINEL) ; Build Service Line Field section
- D BLDAPI(SLINE,.ELINER) ; Build API Line Field section
- S SLINE=$S(ELINEL>ELINER:ELINEL,1:ELINER)
- D BLDCOM(SLINE,.ELINEL) ; Build Comment Field section
- S VALMCNT=ELINEL-1
- Q
- ;
- BLDUMO(SLINE,ELINE) ; Build the UMO Field Section
- ; Input:
- ; SLINE - Starting Section Line Number
- ; ELINE - Current Ending Section Line Number
- ; Output: ELINE - Updated Ending Section Line Number
- ;
- N PAYER,PAYID
- S ELINE=$$SET("",$J("",40),SLINE,1) ; Spacing Blank Line
- S ELINE=$$SETN("UM Organization",ELINE,1,1)
- S ELINE=$$SET("Name*: ",$$GET1^DIQ(36,IEN36_",",.01),ELINE,1)
- S PAYER=+$$GET1^DIQ(36,IEN36_",",3.1,"I") ; file 365.12 ien
- S PAYID="" I PAYER>0 S PAYID=$P($G(^IBE(365.12,PAYER,0)),U,2) ; VA national id
- S ELINE=$$SET("National Payer ID: ",PAYID,ELINE,1)
- S ELINE=$$SET("HPID: ",$$HPD^IBCNHUT1(IEN36),ELINE,1)
- Q
- ;
- BLDSUB(SLINE,ELINE) ; Build the Subscriber Fields
- ; Input:
- ; SLINE - Starting Section Line Number
- ; ELINE - Current Ending Section Line Number
- ; Output: ELINE - Updated Ending Section Line Number
- ;
- N INSNODE3,ZIP
- S INSNODE3=$G(^DPT(DFN,.312,IEN312,3))
- S ELINE=$$SET("",$J("",40),SLINE,1) ; Spacing Blank Line
- S ELINE=$$SETN("Subscriber",ELINE,1,1)
- S ELINE=$$SET("Name*: ",$P(INSNODE0,U,17),ELINE,1)
- S ELINE=$$SET("Primary ID*: ",$P(INSNODE0,U,2),ELINE,1)
- S ELINE=$$SET("Address Line 1: ",$P(INSNODE3,U,6),ELINE,1)
- S ELINE=$$SET("Address Line 2: ",$P(INSNODE3,U,7),ELINE,1)
- S ELINE=$$SET("City: ",$P(INSNODE3,U,8),ELINE,1)
- S ELINE=$$SET("State: ",$$GET1^DIQ(5,$P(INSNODE3,U,9)_",",1),ELINE,1)
- S ZIP=$P(INSNODE3,U,10) I $L(ZIP)>5,$E(ZIP,6)'="-" S ZIP=$E(ZIP,1,5)_"-"_$E(ZIP,6,99)
- S ELINE=$$SET("Zip Code: ",ZIP,ELINE,1)
- Q
- ;
- BLDREQ(SLINE,ELINE) ; Build the Requester fields
- ; Input:
- ; SLINE - Starting Section Line Number
- ; ELINE - Current Ending Section Line Number
- ; Output: ELINE - Updated Ending Section Line Number
- ;
- N CNARY,REQIEN,REQSTR,REQDATA,ZIP
- S REQIEN=$P($$SITE^VASITE(),U),REQSTR=$$PRVDATA^IBTRHLO2(REQIEN,4)
- D GETCNUM(.CNARY)
- S ELINE=$$SET("",$J("",40),SLINE,41) ; Spacing Blank Line
- S ELINE=$$SETN("Requester",ELINE,41,1)
- S ELINE=$$SET("Name*: ",$P(REQSTR,U),ELINE,41)
- S ELINE=$$SET("NPI*: ",$P(REQSTR,U,7),ELINE,41)
- S ELINE=$$SET("Taxonomy Code: ",$P($$TAXORG^XUSTAX(REQIEN),U),ELINE,41)
- S ELINE=$$SET("Address Line 1*: ",$P(REQSTR,U,2),ELINE,41)
- S ELINE=$$SET("Address Line 2: ",$P(REQSTR,U,3),ELINE,41)
- S ELINE=$$SET("City*: ",$P(REQSTR,U,4),ELINE,41)
- S ELINE=$$SET("State*: ",$$GET1^DIQ(5,$P(REQSTR,U,5)_",",1),ELINE,41)
- S ZIP=$P(REQSTR,U,6) I $L(ZIP)>5,$E(ZIP,6)'="-" S ZIP=$E(ZIP,1,5)_"-"_$E(ZIP,6,99)
- S ELINE=$$SET("Zip Code*: ",ZIP,ELINE,41)
- S ELINE=$$SET("Contact Name*: ",$$EXTERNAL^DILFD(356.22,.11,,$P(NODE0,U,11)),ELINE,41)
- S ELINE=$$SET("Contact Phone: ",$G(CNARY("TE")),ELINE,41)
- S ELINE=$$SET("Contact Phone Ext.: ",$G(CNARY("EX")),ELINE,41)
- S ELINE=$$SET("Contact Fax: ",$G(CNARY("FX")),ELINE,41)
- Q
- ;
- BLDDEP(SLINE,ELINE) ; Build the Dependent fields
- ; Input:
- ; SLINE - Starting Section Line Number
- ; ELINE - Current Ending Section Line Number
- ; Output: ELINE - Updated Ending Section Line Number
- ;
- N INSNODE4
- S INSNODE4=$G(^DPT(DFN,.312,IEN312,4))
- I $P(INSNODE4,U,3)="18" Q ; pat. relationship is "self"
- S ELINE=$$SET("",$J("",40),SLINE,1)
- S ELINE=$$SETN("Dependent",ELINE,1,1)
- S ELINE=$$SET("Name*: ",VADM(1),ELINE,1)
- Q
- ;
- BLDDIAG(SLINE,ELINE) ; Build the Diagnosis fields
- ; Input:
- ; SLINE - Starting Section Line Number
- ; ELINE - Current Ending Section Line Number
- ; Output: ELINE - Updated Ending Section Line Number
- ;
- N DATA,DPTR,QPTR,Z
- S ELINE=$$SET("",$J("",40),ELINE,41)
- S ELINE=$$SETN("Diagnoses",ELINE,41,1)
- S Z=0 F S Z=$O(^IBT(356.22,IBTRIEN,3,Z)) Q:'Z!(Z?1.A) D
- .S DATA=$G(^IBT(356.22,IBTRIEN,3,Z,0)) I DATA'="" D
- ..S QPTR=+$P(DATA,U),DPTR=$P(DATA,U,2)
- ..S ELINE=$$SET("Qualifier: ",$$GET1^DIQ(356.006,QPTR_",",.02),ELINE,41)
- ..S ELINE=$$SET("Diagnosis: ",$$EXTERNAL^DILFD(356.223,.02,,DPTR),ELINE,41)
- ..Q
- .Q
- Q
- ;
- BLDHCSR(SLINE,ELINE) ; Build the Health Care Service Review Fields
- ; Input:
- ; SLINE - Starting Section Line Number
- ; ELINE - Current Ending Section Line Number
- ; Output: ELINE - Updated Ending Section Line Number
- ;
- N Z
- S ELINE=$$SET("",$J("",40),SLINE,1)
- S ELINE=$$SETN("Health Care Service Review",ELINE,1,1)
- S ELINE=$$SET("Category*: ",$$GET1^DIQ(356.001,+$P(NODE2,U)_",",.02),ELINE,1)
- S ELINE=$$SET("Certification Type*: ",$$GET1^DIQ(356.002,+$P(NODE2,U,2)_",",.02),ELINE,1)
- S ELINE=$$SET("Service Type*: ",$$GET1^DIQ(365.013,+$P(NODE2,U,3)_",",.02),ELINE,1)
- I 'INPAT S ELINE=$$SET("Facility Type*: ",$$GET1^DIQ(353.1,+$P(NODE2,U,5)_",",.02),ELINE,1)
- I INPAT D
- .S Z=$P(NODE2,U,6)_$P(NODE2,U,7)
- .I Z="11" S ELINE=$$SET("Bill Type*: ","HOSPITAL/INPATIENT",ELINE,1)
- .S ELINE=$$SET("Adm Type: ",$$EXTERNAL^DILFD(356.22,7.01,,$P(NODE7,U)),ELINE,1)
- .Q
- Q
- ;
- BLDPROV(SLINE,ELINE) ; Build the Provider Information Fields
- ; Input:
- ; SLINE - Starting Section Line Number
- ; ELINE - Current Ending Section Line Number
- ; Output: ELINE - Updated Ending Section Line Number
- ;
- N DATA,PRVDATA,PRVPTR,Z
- S ELINE=$$SET("",$J("",40),ELINE,41)
- S ELINE=$$SETN("Provider Information",ELINE,41,1)
- S Z=0 F S Z=$O(^IBT(356.22,IBTRIEN,13,Z)) Q:'Z!(Z?1.A) D
- .S DATA=$G(^IBT(356.22,IBTRIEN,13,Z,0)) I DATA'="" D
- ..S PRVPTR=$P(DATA,U,3),PRVDATA=$$PRVDATA^IBTRHLO2(+$P(PRVPTR,";"),$P($P(PRVPTR,"(",2),","))
- ..S ELINE=$$SET("Provider Type: ",$$GET1^DIQ(365.022,$P(DATA,U)_",",.02),ELINE,41)
- ..S ELINE=$$SET("Provider Name: ",$P(PRVDATA,U),ELINE,41)
- ..S ELINE=$$SET("Provider NPI: ",$P(PRVDATA,U,7),ELINE,41)
- ..Q
- .Q
- Q
- ;
- BLDSVC(SLINE,ELINE) ; Build the Service Line Fields
- ; Input:
- ; SLINE - Starting Section Line Number
- ; ELINE - Current Ending Section Line Number
- ; Output: ELINE - Updated Ending Section Line Number
- ;
- N CNT,PRCODE,PRTYPE,SNODE0,SNODE1,SNODE12,Z
- S ELINE=$$SET("",$J("",40),SLINE,1)
- S ELINE=$$SETN("Service Lines",ELINE,1,1)
- S (CNT,Z)=0 F S Z=$O(^IBT(356.22,IBTRIEN,16,Z)) Q:'Z!(Z?1.A) D
- .S SNODE0=$G(^IBT(356.22,IBTRIEN,16,Z,0)),SNODE1=$G(^IBT(356.22,IBTRIEN,16,Z,1)),CNT=CNT+1
- .S SNODE12=$G(^IBT(356.22,IBTRIEN,16,Z,12))
- .S ELINE=$$SET("Service Line #: ",CNT,ELINE,1)
- .S ELINE=$$SET("Date of Service: ",$$FMTE^XLFDT($P(SNODE0,U,11),5),ELINE,1)
- .S PRTYPE=$P(SNODE1,U)
- .S PRCODE=$S(PRTYPE="N4":$P(SNODE12,U),1:$$EXTERNAL^DILFD(356.2216,1.02,,$P(SNODE1,U,2)))
- .S ELINE=$$SET("Procedure Code*: ",PRCODE,ELINE,1)
- .Q
- Q
- ;
- BLDAPI(SLINE,ELINE) ; Build the Additional Patient Information Fields
- ; Input:
- ; SLINE - Starting Section Line Number
- ; ELINE - Current Ending Section Line Number
- ; Output: ELINE - Updated Ending Section Line Number
- ;
- N ANODE0,Z
- S ELINE=$$SET("",$J("",40),SLINE,41)
- S ELINE=$$SETN("Paperwork Attachments",ELINE,41,1)
- S Z=0 F S Z=$O(^IBT(356.22,IBTRIEN,11,Z)) Q:'Z!(Z?1.A) D
- .S ANODE0=$G(^IBT(356.22,IBTRIEN,11,Z,0))
- .S ELINE=$$SET("Report Type: ",$$GET1^DIQ(356.018,+$P(ANODE0,U)_",",.02),ELINE,41)
- .S ELINE=$$SET("Transmission Method: ",$$EXTERNAL^DILFD(356.2211,.02,,$P(ANODE0,U,2)),ELINE,41)
- .S ELINE=$$SET("Attachment Control Number: ",$P(ANODE0,U,3),ELINE,41)
- .Q
- Q
- ;
- BLDCOM(SLINE,ELINE) ; Build the Comment Fields
- ; Input:
- ; SLINE - Starting Section Line Number
- ; ELINE - Current Ending Section Line Number
- ; Output: ELINE - Updated Ending Section Line Number
- ;
- N XX
- S ELINE=$$SET("",$J("",40),SLINE,1)
- S ELINE=$$SETN("Request Comments",ELINE,1,1)
- K ^UTILITY($J,"W")
- D FORMAT^IBDFU6("^IBT(356.22,IBTRIEN,12)",80,"Message: ")
- S XX=0 F S XX=$O(^UTILITY($J,"W",1,XX)) Q:XX="" S ELINE=$$SET("",$G(^UTILITY($J,"W",1,XX,0)),ELINE,1)
- K ^UTILITY($J,"W")
- Q
- ;
- SET(LABEL,DATA,LINE,COL) ; Sets text into the body of the worklist
- ; Input: LABEL - Label text to set into the line
- ; DATA - Field Data to set into the line
- ; LINE - Line to set LABEL and DATA into
- ; COL - Starting column position in LINE to insert
- ; LABEL_DATA text
- ; Returns: LINE - Updated Line by 1
- ;
- N IBY
- S IBY=LABEL_DATA
- D SET1(IBY,LINE,COL,$L(IBY))
- S LINE=LINE+1
- Q LINE
- ;
- SETN(TITLE,LINE,COL,RV) ; Sets a field Section title into the body of the worklist
- ; Input: TITLE - Text to be used for the field Section Title
- ; LINE - Line number in the body to insert the field section title
- ; COL - Starting Column position to set Section Title into
- ; RV - 1 - Set Reverse Video, 0 or null don't use Reverse Video
- ; Optional, defaults to ""
- ; Returns: LINE - Line number increased by 1
- ;
- N IBY
- S IBY=" "_TITLE_" "
- D SET1(IBY,LINE,COL,$L(IBY),$G(RV))
- S LINE=LINE+1
- Q LINE
- ;
- SET1(TEXT,LINE,COL,WIDTH,RV) ; Sets the TMP array with body data
- ; Input: TEXT - Text to be set into the specified line
- ; LINE - Line to set TEXT into
- ; COL - Column of LINE to set TEXT into
- ; WIDTH - Width of the TEXT being set into line
- ; RV - 1 - Set Reverse Video, 0 or null don't use
- ; Reverse Video
- ; Optional, defaults to ""
- ; ^TMP("IBTRH6",$J) - Current ^TMP array
- ; Output: ^TMP("IBTRH6",$J) - Updated ^TMP array
- ;
- N IBX
- S IBX=$G(^TMP("IBTRH6",$J,LINE,0))
- S IBX=$$SETSTR^VALM1(TEXT,IBX,COL,WIDTH)
- D SET^VALM10(LINE,IBX)
- D:$G(RV)'="" CNTRL^VALM10(LINE,COL,WIDTH,IORVON,IORVOFF)
- Q
- ;
- DATA ;EP
- ; Protocol action to add/edit fields for the brief 278 request fields
- N DA,DIE,DR,DTOUT,IBPSTAT,IBUPOUT,X,Y
- S VALMBCK="R"
- S FROMDATA=1
- D FULL^VALM1
- I $$STATUS^IBTRH2(IBTRIEN)="0" D PRMARK1^IBTRH1(IBTRIEN,"01") ; Set 'in-progress mark'
- ; Set Initial Values
- S IBPSTAT=$P(NODE0,U,4) ; Patient Status of the entry
- ;
- S DA=IBTRIEN,DIE=356.22,DR="[IB CREATE 278 REQUEST SHORT]",IBUPOUT=0
- D ^DIE
- I +$G(IBUPOUT)!$D(Y) I "^01^03^"[(U_$$STATUS^IBTRH2(IBTRIEN)_U) D:$$CLRASK^IBTRH5K() CLRENTRY^IBTRH5K(IBTRIEN)
- D CLEAN^VALM10,INIT^IBTRH6
- Q
- ;
- SEND278 ;EP
- ; Protocol action to send the completed brief 278 request
- N IBRESP
- S IBTRENT=1
- S VALMBCK="R"
- D SEND278^IBTRH2
- Q
- ;
- HELP ;EP
- ; Protocol Action to display help information
- S X="?"
- D DISP^XQORM1
- W !!
- Q
- ;
- EXIT ;EP
- ; Protocol action to exit the worklist
- K ^TMP("IBTRH6",$J)
- D CLEAR^VALM1
- Q
- ;
- WRTFLDS ; auto populate some fields in 356.22
- N DA,DIE,DR,DTOUT,DUOUT,DIRUT,RIEN,X,Y
- S RIEN=+$P(NODE0,U,11) I 'RIEN S RIEN=DUZ D CLRCNUM(IBTRIEN)
- S DIE=356.22,DA=IBTRIEN,DR="",DR=".11////"_RIEN
- I $P(NODE2,U)="" D
- .I INPAT,WHICH<3 S DR=DR_";2.01///AR" Q
- .S DR=DR_";2.01///HS"
- .Q
- I $P(NODE2,U,3)="" S DR=DR_";2.03///"_$S(WHICH=1:"1",WHICH=2:"MH",1:"88")
- I 'INPAT S DR=DR_";2.04////B" S:$P(NODE2,U,5)="" DR=DR_";2.05///22;2.06///@;2.07///@"
- I INPAT S DR=DR_";2.04////A" S:$P(NODE2,U,6)="" DR=DR_";2.05///@;2.06////1;2.07////1"
- I $P(NODE2,U,2)="" S DR=DR_";2.02///I"
- I $P(NODE7,U)="" S DR=DR_";7.01///Urgent"
- D ^DIE
- Q
- ;
- CLRCNUM(IBTRIEN) ; clear contact numbers in file 356.22
- N FDA,FLD,IENS
- S IENS=IBTRIEN_","
- F FLD=19.01,19.02,19.03,20,21,22 S FDA(356.22,IENS,FLD)="@"
- D FILE^DIE("ET","FDA")
- Q
- ;
- WRTCNUM ; auto populate contact numbers in file 356.22
- N CNARY,FDA,FLD,IENS,IENS200,QUAL,RDATA,RIEN,STOPFLG,VALUE,Z
- S RIEN=+$P($G(^IBT(356.22,IBTRIEN,0)),U,11) I 'RIEN Q
- S IENS200=RIEN_"," D GETS^DIQ(200,IENS200,".131;.132;.135;.136",,"RDATA"),GETCNUM(.CNARY)
- ; loop through contact #s in file 200
- S IENS=IBTRIEN_",",STOPFLG=0 F FLD=.135,.132,.136,.131 D Q:STOPFLG
- .I '$D(CNARY("EMPTY")) S STOPFLG=1 Q ; no more empty comm. # fields in 356.22
- .S VALUE=$$NOPUNCT^IBCEF($G(RDATA(200,IENS200,FLD)),1) I VALUE=""!($L(VALUE)>10) Q ; no value to file or value is too long
- .S QUAL=$S(FLD=.136:"FX",1:"TE")
- .I $G(CNARY(QUAL))'="" Q ; this type of comm # already exists in 356.22
- .S Z=$O(CNARY("EMPTY",""))
- .K FDA S FDA(356.22,IENS,$P(Z,U))=QUAL D FILE^DIE("E","FDA")
- .K FDA S FDA(356.22,IENS,$P(Z,U,3))=VALUE D FILE^DIE("E","FDA")
- .K CNARY("EMPTY",Z) S CNARY(QUAL)=VALUE
- .Q
- Q
- ;
- GETCNUM(CNARY) ; get contact numbers from file 356.22
- ; CNARY - array of results, passed by reference
- ;
- N QUAL,VALUE,Z
- S CNARY=0 F Z="19.01^2^20","19.02^3^21","19.03^4^22" D
- .S QUAL=$$EXTERNAL^DILFD(356.22,$P(Z,U),,$P(NODE19,U,$P(Z,U,2)))
- .S VALUE=$G(^IBT(356.22,IBTRIEN,$P(Z,U,3)))
- .I QUAL'="",VALUE'="" S CNARY(QUAL)=VALUE Q
- .S CNARY("EMPTY",Z)=""
- .Q
- Q
- ;
- NEWSL(IBTRIEN) ; create new entry in service line multiple (356.2216) if no entries are there
- ; IBTRIEN - ien of the entry in file 356.22
- ;
- N DA,DD,DIC,DO,DINUM,DLAYGO,DTOUT,DUOUT,RES,X,Y
- S RES=0 I '+$G(IBTRIEN) G NEWSLX
- S RES=1 I '$D(^IBT(356.22,IBTRIEN,16,1)) D
- .S DA(1)=IBTRIEN,DLAYGO=356.2216,DIC(0)="L",DIC="^IBT(356.22,"_DA(1)_",1,",X=1
- .D FILE^DICN S RES=+Y K DD,DO
- .Q
- NEWSLX ;
- Q RES
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRH6 16934 printed Jan 18, 2025@03:29:30 Page 2
- IBTRH6 ;ALB/FA - HCSR Send 278 Short Worklist ;11-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 ;
- EN ; Main entry point for the IBT HCSR SEND 278 SHORT worklist
- +1 ; Displays the selected 278 short form for sending 278 requests
- +2 ; Input: IBTRIEN - IEN of the selected entry to send a request for
- +3 NEW FROMDATA,IBTRENT,INPAT,NODE2,NODE7,NODE19,VADM,WHICH
- +4 ;;12/9/14 JWS - prevent entry if status is PENDING a response
- +5 IF $$STATUS^IBTRH2(IBTRIEN)="07"
- DO STATMSG^IBTRH2A(4)
- QUIT
- +6 SET VALMBCK="R"
- +7 SET FROMDATA=0
- +8 ; 1 if inpatient, 0 if outpatient
- SET INPAT=$SELECT($PIECE(NODE0,U,4)="I":1,1:0)
- +9 ; type of request
- SET WHICH=$$SELSHORT(INPAT)
- +10 IF WHICH'=""
- DO EN^VALM("IBT HCSR SEND 278 SHORT")
- +11 IF $DATA(IBFASTXT)
- SET VALMBCK="Q"
- +12 QUIT
- +13 ;
- SELSHORT(INPAT) ; User selection of which 278 request to send
- +1 ; Input: INPAT=1 if inpatient, 0 otherwise
- +2 ; Returns: Selected Input Type or "" if none selected
- +3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,XX,Y
- +4 DO FULL^VALM1
- +5 IF INPAT
- SET XX="1:Admission (initial);2:Mental Health Inpatient (initial)"
- +6 IF 'INPAT
- SET XX="1:Appointment (initial);2:Mental Health Outpatient (initial)"
- +7 SET XX=XX_";3:Prescription (initial)"
- +8 SET DIR(0)="S^"_XX
- SET DIR("A")="Select Input Type"
- +9 DO ^DIR
- +10 ; User Pressed ^ or timed out
- if $DATA(DIRUT)
- QUIT ""
- +11 IF Y'=1
- Begin DoDot:1
- +12 WRITE !,"Mental Health and Prescription options are not currently available."
- +13 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
- +14 SET DIR(0)="EA"
- +15 SET DIR("A",1)=" "
- +16 SET DIR("A")="Press RETURN to continue "
- DO ^DIR
- End DoDot:1
- SET Y=""
- +17 QUIT Y
- +18 ;
- HDR ;EP
- +1 ; Protocol action to display Worklist Patient header information
- +2 ; Input: IBTRIEN - IEN of the selected entry to send a request for
- +3 ; Output: Header information for the patient of the selected entry is set
- +4 ;
- +5 NEW Z
- +6 SET Z=$EXTRACT(VADM(1),1,28)
- SET Z=Z_$JUSTIFY("",35-$LENGTH(Z))_$PIECE(VADM(2),U,2)_" DOB: "_$PIECE(VADM(3),U,2)_" AGE: "_VADM(4)
- +7 SET VALMHDR(1)=Z
- +8 SET VALMSG="*/Required"
- +9 QUIT
- +10 ;
- INIT ;EP
- +1 ;
- +2 KILL ^TMP("IBTRH6",$JOB)
- +3 SET VALMBG=1
- +4 ; get patient demographics
- DO DEM^VADPT
- +5 SET NODE0=$GET(^IBT(356.22,IBTRIEN,0))
- +6 SET NODE2=$GET(^IBT(356.22,IBTRIEN,2))
- +7 SET NODE7=$GET(^IBT(356.22,IBTRIEN,7))
- +8 SET NODE19=$GET(^IBT(356.22,IBTRIEN,19))
- +9 ; auto populate fields
- DO WRTFLDS
- if 'FROMDATA
- DO WRTCNUM
- +10 ; re-read nodes to get auto-populated values
- +11 SET NODE0=$GET(^IBT(356.22,IBTRIEN,0))
- +12 SET NODE2=$GET(^IBT(356.22,IBTRIEN,2))
- +13 SET NODE7=$GET(^IBT(356.22,IBTRIEN,7))
- +14 SET NODE19=$GET(^IBT(356.22,IBTRIEN,19))
- +15 DO BLD
- +16 IF WHICH=1
- SET VALM("TITLE")="HCSR 278 "_$SELECT(INPAT:"Admission",1:"Appointment")_" - Brief"
- +17 IF WHICH=2
- SET VALM("TITLE")="HCSR 278 Mental - Brief"
- +18 IF WHICH=3
- SET VALM("TITLE")="HCSR 278 Prescription - Brief"
- +19 QUIT
- +20 ;
- BLD ; Creates the body of the worklist
- +1 ;
- +2 NEW ELINEL,ELINER,SLINE
- +3 SET SLINE=1
- +4 ; Build UMO Field section
- DO BLDUMO(SLINE,.ELINEL)
- +5 ; Build Subscriber Field section
- DO BLDSUB(ELINEL,.ELINEL)
- +6 ; Build Requester Field section
- DO BLDREQ(SLINE,.ELINER)
- +7 SET SLINE=$SELECT(ELINEL>ELINER:ELINEL,1:ELINER)
- +8 ; Build Dependent Field section
- DO BLDDEP(SLINE,.ELINEL)
- +9 ; Build Diagnoses Field section
- DO BLDDIAG(SLINE,.ELINER)
- +10 SET SLINE=$SELECT(ELINEL>ELINER:ELINEL,1:ELINER)
- +11 ; Build Health Care Services Field section
- DO BLDHCSR(SLINE,.ELINEL)
- +12 ; Build Provider Field section
- DO BLDPROV(SLINE,.ELINER)
- +13 SET SLINE=$SELECT(ELINEL>ELINER:ELINEL,1:ELINER)
- +14 ; Build Service Line Field section
- DO BLDSVC(SLINE,.ELINEL)
- +15 ; Build API Line Field section
- DO BLDAPI(SLINE,.ELINER)
- +16 SET SLINE=$SELECT(ELINEL>ELINER:ELINEL,1:ELINER)
- +17 ; Build Comment Field section
- DO BLDCOM(SLINE,.ELINEL)
- +18 SET VALMCNT=ELINEL-1
- +19 QUIT
- +20 ;
- BLDUMO(SLINE,ELINE) ; Build the UMO Field Section
- +1 ; Input:
- +2 ; SLINE - Starting Section Line Number
- +3 ; ELINE - Current Ending Section Line Number
- +4 ; Output: ELINE - Updated Ending Section Line Number
- +5 ;
- +6 NEW PAYER,PAYID
- +7 ; Spacing Blank Line
- SET ELINE=$$SET("",$JUSTIFY("",40),SLINE,1)
- +8 SET ELINE=$$SETN("UM Organization",ELINE,1,1)
- +9 SET ELINE=$$SET("Name*: ",$$GET1^DIQ(36,IEN36_",",.01),ELINE,1)
- +10 ; file 365.12 ien
- SET PAYER=+$$GET1^DIQ(36,IEN36_",",3.1,"I")
- +11 ; VA national id
- SET PAYID=""
- IF PAYER>0
- SET PAYID=$PIECE($GET(^IBE(365.12,PAYER,0)),U,2)
- +12 SET ELINE=$$SET("National Payer ID: ",PAYID,ELINE,1)
- +13 SET ELINE=$$SET("HPID: ",$$HPD^IBCNHUT1(IEN36),ELINE,1)
- +14 QUIT
- +15 ;
- BLDSUB(SLINE,ELINE) ; Build the Subscriber Fields
- +1 ; Input:
- +2 ; SLINE - Starting Section Line Number
- +3 ; ELINE - Current Ending Section Line Number
- +4 ; Output: ELINE - Updated Ending Section Line Number
- +5 ;
- +6 NEW INSNODE3,ZIP
- +7 SET INSNODE3=$GET(^DPT(DFN,.312,IEN312,3))
- +8 ; Spacing Blank Line
- SET ELINE=$$SET("",$JUSTIFY("",40),SLINE,1)
- +9 SET ELINE=$$SETN("Subscriber",ELINE,1,1)
- +10 SET ELINE=$$SET("Name*: ",$PIECE(INSNODE0,U,17),ELINE,1)
- +11 SET ELINE=$$SET("Primary ID*: ",$PIECE(INSNODE0,U,2),ELINE,1)
- +12 SET ELINE=$$SET("Address Line 1: ",$PIECE(INSNODE3,U,6),ELINE,1)
- +13 SET ELINE=$$SET("Address Line 2: ",$PIECE(INSNODE3,U,7),ELINE,1)
- +14 SET ELINE=$$SET("City: ",$PIECE(INSNODE3,U,8),ELINE,1)
- +15 SET ELINE=$$SET("State: ",$$GET1^DIQ(5,$PIECE(INSNODE3,U,9)_",",1),ELINE,1)
- +16 SET ZIP=$PIECE(INSNODE3,U,10)
- IF $LENGTH(ZIP)>5
- IF $EXTRACT(ZIP,6)'="-"
- SET ZIP=$EXTRACT(ZIP,1,5)_"-"_$EXTRACT(ZIP,6,99)
- +17 SET ELINE=$$SET("Zip Code: ",ZIP,ELINE,1)
- +18 QUIT
- +19 ;
- BLDREQ(SLINE,ELINE) ; Build the Requester fields
- +1 ; Input:
- +2 ; SLINE - Starting Section Line Number
- +3 ; ELINE - Current Ending Section Line Number
- +4 ; Output: ELINE - Updated Ending Section Line Number
- +5 ;
- +6 NEW CNARY,REQIEN,REQSTR,REQDATA,ZIP
- +7 SET REQIEN=$PIECE($$SITE^VASITE(),U)
- SET REQSTR=$$PRVDATA^IBTRHLO2(REQIEN,4)
- +8 DO GETCNUM(.CNARY)
- +9 ; Spacing Blank Line
- SET ELINE=$$SET("",$JUSTIFY("",40),SLINE,41)
- +10 SET ELINE=$$SETN("Requester",ELINE,41,1)
- +11 SET ELINE=$$SET("Name*: ",$PIECE(REQSTR,U),ELINE,41)
- +12 SET ELINE=$$SET("NPI*: ",$PIECE(REQSTR,U,7),ELINE,41)
- +13 SET ELINE=$$SET("Taxonomy Code: ",$PIECE($$TAXORG^XUSTAX(REQIEN),U),ELINE,41)
- +14 SET ELINE=$$SET("Address Line 1*: ",$PIECE(REQSTR,U,2),ELINE,41)
- +15 SET ELINE=$$SET("Address Line 2: ",$PIECE(REQSTR,U,3),ELINE,41)
- +16 SET ELINE=$$SET("City*: ",$PIECE(REQSTR,U,4),ELINE,41)
- +17 SET ELINE=$$SET("State*: ",$$GET1^DIQ(5,$PIECE(REQSTR,U,5)_",",1),ELINE,41)
- +18 SET ZIP=$PIECE(REQSTR,U,6)
- IF $LENGTH(ZIP)>5
- IF $EXTRACT(ZIP,6)'="-"
- SET ZIP=$EXTRACT(ZIP,1,5)_"-"_$EXTRACT(ZIP,6,99)
- +19 SET ELINE=$$SET("Zip Code*: ",ZIP,ELINE,41)
- +20 SET ELINE=$$SET("Contact Name*: ",$$EXTERNAL^DILFD(356.22,.11,,$PIECE(NODE0,U,11)),ELINE,41)
- +21 SET ELINE=$$SET("Contact Phone: ",$GET(CNARY("TE")),ELINE,41)
- +22 SET ELINE=$$SET("Contact Phone Ext.: ",$GET(CNARY("EX")),ELINE,41)
- +23 SET ELINE=$$SET("Contact Fax: ",$GET(CNARY("FX")),ELINE,41)
- +24 QUIT
- +25 ;
- BLDDEP(SLINE,ELINE) ; Build the Dependent fields
- +1 ; Input:
- +2 ; SLINE - Starting Section Line Number
- +3 ; ELINE - Current Ending Section Line Number
- +4 ; Output: ELINE - Updated Ending Section Line Number
- +5 ;
- +6 NEW INSNODE4
- +7 SET INSNODE4=$GET(^DPT(DFN,.312,IEN312,4))
- +8 ; pat. relationship is "self"
- IF $PIECE(INSNODE4,U,3)="18"
- QUIT
- +9 SET ELINE=$$SET("",$JUSTIFY("",40),SLINE,1)
- +10 SET ELINE=$$SETN("Dependent",ELINE,1,1)
- +11 SET ELINE=$$SET("Name*: ",VADM(1),ELINE,1)
- +12 QUIT
- +13 ;
- BLDDIAG(SLINE,ELINE) ; Build the Diagnosis fields
- +1 ; Input:
- +2 ; SLINE - Starting Section Line Number
- +3 ; ELINE - Current Ending Section Line Number
- +4 ; Output: ELINE - Updated Ending Section Line Number
- +5 ;
- +6 NEW DATA,DPTR,QPTR,Z
- +7 SET ELINE=$$SET("",$JUSTIFY("",40),ELINE,41)
- +8 SET ELINE=$$SETN("Diagnoses",ELINE,41,1)
- +9 SET Z=0
- FOR
- SET Z=$ORDER(^IBT(356.22,IBTRIEN,3,Z))
- if 'Z!(Z?1.A)
- QUIT
- Begin DoDot:1
- +10 SET DATA=$GET(^IBT(356.22,IBTRIEN,3,Z,0))
- IF DATA'=""
- Begin DoDot:2
- +11 SET QPTR=+$PIECE(DATA,U)
- SET DPTR=$PIECE(DATA,U,2)
- +12 SET ELINE=$$SET("Qualifier: ",$$GET1^DIQ(356.006,QPTR_",",.02),ELINE,41)
- +13 SET ELINE=$$SET("Diagnosis: ",$$EXTERNAL^DILFD(356.223,.02,,DPTR),ELINE,41)
- +14 QUIT
- End DoDot:2
- +15 QUIT
- End DoDot:1
- +16 QUIT
- +17 ;
- BLDHCSR(SLINE,ELINE) ; Build the Health Care Service Review Fields
- +1 ; Input:
- +2 ; SLINE - Starting Section Line Number
- +3 ; ELINE - Current Ending Section Line Number
- +4 ; Output: ELINE - Updated Ending Section Line Number
- +5 ;
- +6 NEW Z
- +7 SET ELINE=$$SET("",$JUSTIFY("",40),SLINE,1)
- +8 SET ELINE=$$SETN("Health Care Service Review",ELINE,1,1)
- +9 SET ELINE=$$SET("Category*: ",$$GET1^DIQ(356.001,+$PIECE(NODE2,U)_",",.02),ELINE,1)
- +10 SET ELINE=$$SET("Certification Type*: ",$$GET1^DIQ(356.002,+$PIECE(NODE2,U,2)_",",.02),ELINE,1)
- +11 SET ELINE=$$SET("Service Type*: ",$$GET1^DIQ(365.013,+$PIECE(NODE2,U,3)_",",.02),ELINE,1)
- +12 IF 'INPAT
- SET ELINE=$$SET("Facility Type*: ",$$GET1^DIQ(353.1,+$PIECE(NODE2,U,5)_",",.02),ELINE,1)
- +13 IF INPAT
- Begin DoDot:1
- +14 SET Z=$PIECE(NODE2,U,6)_$PIECE(NODE2,U,7)
- +15 IF Z="11"
- SET ELINE=$$SET("Bill Type*: ","HOSPITAL/INPATIENT",ELINE,1)
- +16 SET ELINE=$$SET("Adm Type: ",$$EXTERNAL^DILFD(356.22,7.01,,$PIECE(NODE7,U)),ELINE,1)
- +17 QUIT
- End DoDot:1
- +18 QUIT
- +19 ;
- BLDPROV(SLINE,ELINE) ; Build the Provider Information Fields
- +1 ; Input:
- +2 ; SLINE - Starting Section Line Number
- +3 ; ELINE - Current Ending Section Line Number
- +4 ; Output: ELINE - Updated Ending Section Line Number
- +5 ;
- +6 NEW DATA,PRVDATA,PRVPTR,Z
- +7 SET ELINE=$$SET("",$JUSTIFY("",40),ELINE,41)
- +8 SET ELINE=$$SETN("Provider Information",ELINE,41,1)
- +9 SET Z=0
- FOR
- SET Z=$ORDER(^IBT(356.22,IBTRIEN,13,Z))
- if 'Z!(Z?1.A)
- QUIT
- Begin DoDot:1
- +10 SET DATA=$GET(^IBT(356.22,IBTRIEN,13,Z,0))
- IF DATA'=""
- Begin DoDot:2
- +11 SET PRVPTR=$PIECE(DATA,U,3)
- SET PRVDATA=$$PRVDATA^IBTRHLO2(+$PIECE(PRVPTR,";"),$PIECE($PIECE(PRVPTR,"(",2),","))
- +12 SET ELINE=$$SET("Provider Type: ",$$GET1^DIQ(365.022,$PIECE(DATA,U)_",",.02),ELINE,41)
- +13 SET ELINE=$$SET("Provider Name: ",$PIECE(PRVDATA,U),ELINE,41)
- +14 SET ELINE=$$SET("Provider NPI: ",$PIECE(PRVDATA,U,7),ELINE,41)
- +15 QUIT
- End DoDot:2
- +16 QUIT
- End DoDot:1
- +17 QUIT
- +18 ;
- BLDSVC(SLINE,ELINE) ; Build the Service Line Fields
- +1 ; Input:
- +2 ; SLINE - Starting Section Line Number
- +3 ; ELINE - Current Ending Section Line Number
- +4 ; Output: ELINE - Updated Ending Section Line Number
- +5 ;
- +6 NEW CNT,PRCODE,PRTYPE,SNODE0,SNODE1,SNODE12,Z
- +7 SET ELINE=$$SET("",$JUSTIFY("",40),SLINE,1)
- +8 SET ELINE=$$SETN("Service Lines",ELINE,1,1)
- +9 SET (CNT,Z)=0
- FOR
- SET Z=$ORDER(^IBT(356.22,IBTRIEN,16,Z))
- if 'Z!(Z?1.A)
- QUIT
- Begin DoDot:1
- +10 SET SNODE0=$GET(^IBT(356.22,IBTRIEN,16,Z,0))
- SET SNODE1=$GET(^IBT(356.22,IBTRIEN,16,Z,1))
- SET CNT=CNT+1
- +11 SET SNODE12=$GET(^IBT(356.22,IBTRIEN,16,Z,12))
- +12 SET ELINE=$$SET("Service Line #: ",CNT,ELINE,1)
- +13 SET ELINE=$$SET("Date of Service: ",$$FMTE^XLFDT($PIECE(SNODE0,U,11),5),ELINE,1)
- +14 SET PRTYPE=$PIECE(SNODE1,U)
- +15 SET PRCODE=$SELECT(PRTYPE="N4":$PIECE(SNODE12,U),1:$$EXTERNAL^DILFD(356.2216,1.02,,$PIECE(SNODE1,U,2)))
- +16 SET ELINE=$$SET("Procedure Code*: ",PRCODE,ELINE,1)
- +17 QUIT
- End DoDot:1
- +18 QUIT
- +19 ;
- BLDAPI(SLINE,ELINE) ; Build the Additional Patient Information Fields
- +1 ; Input:
- +2 ; SLINE - Starting Section Line Number
- +3 ; ELINE - Current Ending Section Line Number
- +4 ; Output: ELINE - Updated Ending Section Line Number
- +5 ;
- +6 NEW ANODE0,Z
- +7 SET ELINE=$$SET("",$JUSTIFY("",40),SLINE,41)
- +8 SET ELINE=$$SETN("Paperwork Attachments",ELINE,41,1)
- +9 SET Z=0
- FOR
- SET Z=$ORDER(^IBT(356.22,IBTRIEN,11,Z))
- if 'Z!(Z?1.A)
- QUIT
- Begin DoDot:1
- +10 SET ANODE0=$GET(^IBT(356.22,IBTRIEN,11,Z,0))
- +11 SET ELINE=$$SET("Report Type: ",$$GET1^DIQ(356.018,+$PIECE(ANODE0,U)_",",.02),ELINE,41)
- +12 SET ELINE=$$SET("Transmission Method: ",$$EXTERNAL^DILFD(356.2211,.02,,$PIECE(ANODE0,U,2)),ELINE,41)
- +13 SET ELINE=$$SET("Attachment Control Number: ",$PIECE(ANODE0,U,3),ELINE,41)
- +14 QUIT
- End DoDot:1
- +15 QUIT
- +16 ;
- BLDCOM(SLINE,ELINE) ; Build the Comment Fields
- +1 ; Input:
- +2 ; SLINE - Starting Section Line Number
- +3 ; ELINE - Current Ending Section Line Number
- +4 ; Output: ELINE - Updated Ending Section Line Number
- +5 ;
- +6 NEW XX
- +7 SET ELINE=$$SET("",$JUSTIFY("",40),SLINE,1)
- +8 SET ELINE=$$SETN("Request Comments",ELINE,1,1)
- +9 KILL ^UTILITY($JOB,"W")
- +10 DO FORMAT^IBDFU6("^IBT(356.22,IBTRIEN,12)",80,"Message: ")
- +11 SET XX=0
- FOR
- SET XX=$ORDER(^UTILITY($JOB,"W",1,XX))
- if XX=""
- QUIT
- SET ELINE=$$SET("",$GET(^UTILITY($JOB,"W",1,XX,0)),ELINE,1)
- +12 KILL ^UTILITY($JOB,"W")
- +13 QUIT
- +14 ;
- SET(LABEL,DATA,LINE,COL) ; Sets text into the body of the worklist
- +1 ; Input: LABEL - Label text to set into the line
- +2 ; DATA - Field Data to set into the line
- +3 ; LINE - Line to set LABEL and DATA into
- +4 ; COL - Starting column position in LINE to insert
- +5 ; LABEL_DATA text
- +6 ; Returns: LINE - Updated Line by 1
- +7 ;
- +8 NEW IBY
- +9 SET IBY=LABEL_DATA
- +10 DO SET1(IBY,LINE,COL,$LENGTH(IBY))
- +11 SET LINE=LINE+1
- +12 QUIT LINE
- +13 ;
- SETN(TITLE,LINE,COL,RV) ; Sets a field Section title into the body of the worklist
- +1 ; Input: TITLE - Text to be used for the field Section Title
- +2 ; LINE - Line number in the body to insert the field section title
- +3 ; COL - Starting Column position to set Section Title into
- +4 ; RV - 1 - Set Reverse Video, 0 or null don't use Reverse Video
- +5 ; Optional, defaults to ""
- +6 ; Returns: LINE - Line number increased by 1
- +7 ;
- +8 NEW IBY
- +9 SET IBY=" "_TITLE_" "
- +10 DO SET1(IBY,LINE,COL,$LENGTH(IBY),$GET(RV))
- +11 SET LINE=LINE+1
- +12 QUIT LINE
- +13 ;
- SET1(TEXT,LINE,COL,WIDTH,RV) ; Sets the TMP array with body data
- +1 ; Input: TEXT - Text to be set into the specified line
- +2 ; LINE - Line to set TEXT into
- +3 ; COL - Column of LINE to set TEXT into
- +4 ; WIDTH - Width of the TEXT being set into line
- +5 ; RV - 1 - Set Reverse Video, 0 or null don't use
- +6 ; Reverse Video
- +7 ; Optional, defaults to ""
- +8 ; ^TMP("IBTRH6",$J) - Current ^TMP array
- +9 ; Output: ^TMP("IBTRH6",$J) - Updated ^TMP array
- +10 ;
- +11 NEW IBX
- +12 SET IBX=$GET(^TMP("IBTRH6",$JOB,LINE,0))
- +13 SET IBX=$$SETSTR^VALM1(TEXT,IBX,COL,WIDTH)
- +14 DO SET^VALM10(LINE,IBX)
- +15 if $GET(RV)'=""
- DO CNTRL^VALM10(LINE,COL,WIDTH,IORVON,IORVOFF)
- +16 QUIT
- +17 ;
- DATA ;EP
- +1 ; Protocol action to add/edit fields for the brief 278 request fields
- +2 NEW DA,DIE,DR,DTOUT,IBPSTAT,IBUPOUT,X,Y
- +3 SET VALMBCK="R"
- +4 SET FROMDATA=1
- +5 DO FULL^VALM1
- +6 ; Set 'in-progress mark'
- IF $$STATUS^IBTRH2(IBTRIEN)="0"
- DO PRMARK1^IBTRH1(IBTRIEN,"01")
- +7 ; Set Initial Values
- +8 ; Patient Status of the entry
- SET IBPSTAT=$PIECE(NODE0,U,4)
- +9 ;
- +10 SET DA=IBTRIEN
- SET DIE=356.22
- SET DR="[IB CREATE 278 REQUEST SHORT]"
- SET IBUPOUT=0
- +11 DO ^DIE
- +12 IF +$GET(IBUPOUT)!$DATA(Y)
- IF "^01^03^"[(U_$$STATUS^IBTRH2(IBTRIEN)_U)
- if $$CLRASK^IBTRH5K()
- DO CLRENTRY^IBTRH5K(IBTRIEN)
- +13 DO CLEAN^VALM10
- DO INIT^IBTRH6
- +14 QUIT
- +15 ;
- SEND278 ;EP
- +1 ; Protocol action to send the completed brief 278 request
- +2 NEW IBRESP
- +3 SET IBTRENT=1
- +4 SET VALMBCK="R"
- +5 DO SEND278^IBTRH2
- +6 QUIT
- +7 ;
- HELP ;EP
- +1 ; Protocol Action to display help information
- +2 SET X="?"
- +3 DO DISP^XQORM1
- +4 WRITE !!
- +5 QUIT
- +6 ;
- EXIT ;EP
- +1 ; Protocol action to exit the worklist
- +2 KILL ^TMP("IBTRH6",$JOB)
- +3 DO CLEAR^VALM1
- +4 QUIT
- +5 ;
- WRTFLDS ; auto populate some fields in 356.22
- +1 NEW DA,DIE,DR,DTOUT,DUOUT,DIRUT,RIEN,X,Y
- +2 SET RIEN=+$PIECE(NODE0,U,11)
- IF 'RIEN
- SET RIEN=DUZ
- DO CLRCNUM(IBTRIEN)
- +3 SET DIE=356.22
- SET DA=IBTRIEN
- SET DR=""
- SET DR=".11////"_RIEN
- +4 IF $PIECE(NODE2,U)=""
- Begin DoDot:1
- +5 IF INPAT
- IF WHICH<3
- SET DR=DR_";2.01///AR"
- QUIT
- +6 SET DR=DR_";2.01///HS"
- +7 QUIT
- End DoDot:1
- +8 IF $PIECE(NODE2,U,3)=""
- SET DR=DR_";2.03///"_$SELECT(WHICH=1:"1",WHICH=2:"MH",1:"88")
- +9 IF 'INPAT
- SET DR=DR_";2.04////B"
- if $PIECE(NODE2,U,5)=""
- SET DR=DR_";2.05///22;2.06///@;2.07///@"
- +10 IF INPAT
- SET DR=DR_";2.04////A"
- if $PIECE(NODE2,U,6)=""
- SET DR=DR_";2.05///@;2.06////1;2.07////1"
- +11 IF $PIECE(NODE2,U,2)=""
- SET DR=DR_";2.02///I"
- +12 IF $PIECE(NODE7,U)=""
- SET DR=DR_";7.01///Urgent"
- +13 DO ^DIE
- +14 QUIT
- +15 ;
- CLRCNUM(IBTRIEN) ; clear contact numbers in file 356.22
- +1 NEW FDA,FLD,IENS
- +2 SET IENS=IBTRIEN_","
- +3 FOR FLD=19.01,19.02,19.03,20,21,22
- SET FDA(356.22,IENS,FLD)="@"
- +4 DO FILE^DIE("ET","FDA")
- +5 QUIT
- +6 ;
- WRTCNUM ; auto populate contact numbers in file 356.22
- +1 NEW CNARY,FDA,FLD,IENS,IENS200,QUAL,RDATA,RIEN,STOPFLG,VALUE,Z
- +2 SET RIEN=+$PIECE($GET(^IBT(356.22,IBTRIEN,0)),U,11)
- IF 'RIEN
- QUIT
- +3 SET IENS200=RIEN_","
- DO GETS^DIQ(200,IENS200,".131;.132;.135;.136",,"RDATA")
- DO GETCNUM(.CNARY)
- +4 ; loop through contact #s in file 200
- +5 SET IENS=IBTRIEN_","
- SET STOPFLG=0
- FOR FLD=.135,.132,.136,.131
- Begin DoDot:1
- +6 ; no more empty comm. # fields in 356.22
- IF '$DATA(CNARY("EMPTY"))
- SET STOPFLG=1
- QUIT
- +7 ; no value to file or value is too long
- SET VALUE=$$NOPUNCT^IBCEF($GET(RDATA(200,IENS200,FLD)),1)
- IF VALUE=""!($LENGTH(VALUE)>10)
- QUIT
- +8 SET QUAL=$SELECT(FLD=.136:"FX",1:"TE")
- +9 ; this type of comm # already exists in 356.22
- IF $GET(CNARY(QUAL))'=""
- QUIT
- +10 SET Z=$ORDER(CNARY("EMPTY",""))
- +11 KILL FDA
- SET FDA(356.22,IENS,$PIECE(Z,U))=QUAL
- DO FILE^DIE("E","FDA")
- +12 KILL FDA
- SET FDA(356.22,IENS,$PIECE(Z,U,3))=VALUE
- DO FILE^DIE("E","FDA")
- +13 KILL CNARY("EMPTY",Z)
- SET CNARY(QUAL)=VALUE
- +14 QUIT
- End DoDot:1
- if STOPFLG
- QUIT
- +15 QUIT
- +16 ;
- GETCNUM(CNARY) ; get contact numbers from file 356.22
- +1 ; CNARY - array of results, passed by reference
- +2 ;
- +3 NEW QUAL,VALUE,Z
- +4 SET CNARY=0
- FOR Z="19.01^2^20","19.02^3^21","19.03^4^22"
- Begin DoDot:1
- +5 SET QUAL=$$EXTERNAL^DILFD(356.22,$PIECE(Z,U),,$PIECE(NODE19,U,$PIECE(Z,U,2)))
- +6 SET VALUE=$GET(^IBT(356.22,IBTRIEN,$PIECE(Z,U,3)))
- +7 IF QUAL'=""
- IF VALUE'=""
- SET CNARY(QUAL)=VALUE
- QUIT
- +8 SET CNARY("EMPTY",Z)=""
- +9 QUIT
- End DoDot:1
- +10 QUIT
- +11 ;
- NEWSL(IBTRIEN) ; create new entry in service line multiple (356.2216) if no entries are there
- +1 ; IBTRIEN - ien of the entry in file 356.22
- +2 ;
- +3 NEW DA,DD,DIC,DO,DINUM,DLAYGO,DTOUT,DUOUT,RES,X,Y
- +4 SET RES=0
- IF '+$GET(IBTRIEN)
- GOTO NEWSLX
- +5 SET RES=1
- IF '$DATA(^IBT(356.22,IBTRIEN,16,1))
- Begin DoDot:1
- +6 SET DA(1)=IBTRIEN
- SET DLAYGO=356.2216
- SET DIC(0)="L"
- SET DIC="^IBT(356.22,"_DA(1)_",1,"
- SET X=1
- +7 DO FILE^DICN
- SET RES=+Y
- KILL DD,DO
- +8 QUIT
- End DoDot:1
- NEWSLX ;
- +1 QUIT RES