IBTRH5E ;ALB/FA - HCSR Create 278 Request ;12-AUG-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 --------------------------------
; SELSL - Allows the user to see a quick view of the currently entered
; Service Lines and either pick one to edit, enter a new one or
; skip.
; SELOU - Allows the user to see a quick view of the currently entered
; Other UMO Information and either pick one to edit, enter a
; new one or skip.
; SELSPD - Allows the user to see a quick view of the currently entered
; Service Line Provider Data Lines and either pick one to edit,
; enter a new one or skip.
;-----------------------------------------------------------------------------
;
SELOU(IBTRIEN) ;EP
; Called from within Input template IB CREATE 278 REQUEST
; Provides the user with a quick view of currently entered Other UMO
; Information multiples and allows them to select one to edit or enter a new
; one.
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; Returns: Value of the .01 field of the multiple to edit
; "" if creating a new multiple, -2 to exit template
; IBNEW=1 when creating a new entry
N CNT,ENTNUM,FDA,IEN,H1,H2,L1,L2,OUDATA,OUTYPE,MAX,RETIEN,SECT,X,XX,Y,YY
S IBNEW=0,SECT="Other UMO Information"
;
; First check for an empty Other UMO Information Lines to delete
D DELOU(IBTRIEN)
;
; Next create an array of all current Other UMO Information lines
S XX=+$P($G(^IBT(356.22,IBTRIEN,15,0)),"^",4) ; Total # of multiples
S MAX=$S(XX<3:"",1:"Other UMO Information Lines")
S IEN=0,CNT=0
F D Q:+IEN=0
. S IEN=$O(^IBT(356.22,IBTRIEN,15,IEN))
. Q:+IEN=0
. S CNT=CNT+1
. S XX=$$LJ^XLFSTR(CNT,4) ; Selection #
. S YY=$$GET1^DIQ(356.2215,IEN_","_DA_",",.01) ; UMO Type
. S YY=$E(YY,1,30)_" "
. S XX=XX_$$LJ^XLFSTR(YY,32)
. S YY=$$GET1^DIQ(356.2215,IEN_","_DA_",",.02) ; UMO Name
. S XX=XX_$$LJ^XLFSTR(YY,"44T")
. S OUDATA(CNT)=IEN_"^"_XX
;
; Creating 1st Other UMO Information Line?
I 'CNT D Q $S($O(RETIEN(0)):RETIEN($O(RETIEN(0))),1:XX)
. W !!,"No Other UMO Information is currently on file.",!
. S XX=$$ASKNEW^IBTRH5D("Add Other UMO Information","NO")
. Q:XX<0
. S OUTYPE=$$OUTYPE(IBTRIEN) ; Get the .01 value
. I OUTYPE="" S XX=-1 Q ; None entered
. S IBNEW=1,XX=OUTYPE
. S FDA(356.2215,"+1,"_IBTRIEN_",",.01)=OUTYPE
. D UPDATE^DIE("","FDA","RETIEN") ; File the new line
;
; Next display all of the current Other UMO Information
S H1="# Type UMO Name"
S H2="-- ------------------------------ ------------------------------"
S L1="The following Other UMO Information is currently on file."
S L2="Enter the # of an entry to edit, 'NEW' to add one or press Return to skip."
S XX=$$SELENT^IBTRH5D(.OUDATA,H1,H2,L1,L2,MAX,"",SECT)
I XX?1"D".N D Q -3
. S (XX,ENTNUM)=$P(XX,"D",2)
. S XX=$P(OUDATA(XX),U)
. D DELOU(IBTRIEN,XX)
. W !,"Entry #",ENTNUM," has been deleted."
;
I XX<0 Q XX
I XX=0 D Q $S($O(RETIEN(0)):RETIEN($O(RETIEN(0))),1:XX)
. S OUTYPE=$$OUTYPE(IBTRIEN) ; Get the .01 value
. I OUTYPE="" S XX=-1 Q ; None entered
. S IBNEW=1
. S XX=OUTYPE
. S FDA(356.2215,"+1,"_IBTRIEN_",",.01)=OUTYPE
. D UPDATE^DIE("","FDA","RETIEN") ; File the new line
Q $P(OUDATA(XX),"^",1)
;
OUTYPE(IBTRIEN) ; Prompts the user to enter the .01 (Entity Identifier) field
; of the Other UMO Information Multiple
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; Returns: Selected Entity Identifier or "" of not entered
N ARR,DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,EIS,ERR,IX,X,XX,YY
S EIS="",IX=0
F D Q:'+IX
. S IX=$O(^IBT(356.22,IBTRIEN,15,IX))
. Q:+IX=0
. S XX=$P(^IBT(356.22,IBTRIEN,15,IX,0),"^",1)
. S EIS=$S(EIS="":XX,1:EIS_"^"_XX)
S DA(1)=IBTRIEN
S:EIS'="" EIS="^"_EIS_"^"
D FIELD^DID(356.2215,.01,,"POINTER","ARR","ERR")
S DIR("A")=" Other UMO Qualifier: "
S XX=""
F IX=1:1:$L(ARR("POINTER"),";") D
. S YY=$P(ARR("POINTER"),";",IX)
. Q:EIS[("^"_$P(YY,":",1)_"^")
. S XX=$S(XX="":YY,1:XX_";"_YY)
S DIR(0)="SOA^"_XX
D ^DIR
Q:$D(DIRUT) ""
Q $P(Y,"^",1)
;
DELOU(IBTRIEN,IEN) ; Checks to see if the user entered 'NEW' to create a new
; Other UMO Information Line and didn't enter any data for it OR selected a
; line to be deleted. If so, the Other Information Line with no data (or'
; selected) is deleted
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; IEN - Optional, IEN of the multiple to be deleted if passed
; defaults to ""
; Output: Empty or selected Other UMO Information line is deleted (Potentially)
N DA,DIK,OUIEN,X,XX,Y
S:'$D(IEN) IEN=""
I IEN'="" D Q
. S DA(1)=IBTRIEN,DA=IEN
. S DIK="^IBT(356.22,DA(1),15,"
. D ^DIK ; Delete the multiple
;
S OUIEN=+$P($G(^IBT(356.22,IBTRIEN,15,0)),"^",3) ; Last Multiple IEN
Q:'OUIEN
S XX=$G(^IBT(356.22,IBTRIEN,15,OUIEN,0))
S $P(XX,"^",1)="" ; Remove .01 field
Q:$TR(XX,"^","")'="" ; 0 node data exists
S DA(1)=IBTRIEN,DA=OUIEN
S DIK="^IBT(356.22,DA(1),15,"
D ^DIK ; Delete the multiple
Q
;
SELSL(IBTRIEN) ;EP
; Called from within Input template IB CREATE 278 REQUEST
; Provides the user with a quick view of currently entered Service Lines and
; allows them to select one to edit or enter a new Service Line.
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; IBTRF - 1 - Being called from the brief form
; Returns: Value of the .01 field of the multiple to edit
; "" if creating a new multiple
; -1 if skipping altogether
; -2 to exit template
; IBNEW=1 when creating a new entry
N CNT,ENTNUM,FDA,H1,H2,IEN,L1,L2,NIEN,RETIEN,SECT,SLDATA,X,XX,Y
S IBNEW=0,SECT="Service Line Detail"
;
; First check for an empty Service Line to delete
D DELSL(IBTRIEN)
;
; Next create an array of all current Service Lines
S NIEN=+$P($G(^IBT(356.22,IBTRIEN,16,0)),"^",3)+1 ; Next Multiple IEN
S IEN=0,CNT=0
F D Q:+IEN=0
. S IEN=$O(^IBT(356.22,IBTRIEN,16,IEN))
. Q:+IEN=0
. S CNT=CNT+1
. S XX=$$GETSELLN(CNT,IBTRIEN,IEN,.H1,.H2) ; Format Service line for display
. S SLDATA(CNT)=IEN_"^"_XX
;
; Creating 1st Service Line?
I 'CNT D Q $S($O(RETIEN(0)):RETIEN($O(RETIEN(0))),1:XX)
.I $G(IBTRBRF)'=1 D
..W !!,"No Service Line Detail is currently on file.",!
..S XX=$$ASKNEW^IBTRH5D("Add a new Service Line")
..Q
.I $G(IBTRBRF)=1 S XX=0
.Q:XX<0
.S IBNEW=1,XX=NIEN
.S FDA(356.2216,"+1,"_IBTRIEN_",",.01)=NIEN
.D UPDATE^DIE("","FDA","RETIEN") ; File the new line
.Q
;
; Next display all of the current Service Lines and let the user select one
S L1="The following Service Lines are currently on file."
S L2="Enter the # of a line to edit, 'NEW' to add one or press Return to skip."
S XX=$$SELENT^IBTRH5D(.SLDATA,H1,H2,L1,L2,"",SECT)
I XX?1"D".N D Q -3
. S (XX,ENTNUM)=$P(XX,"D",2)
. S XX=$P(SLDATA(XX),"^",1)
. D DELSL(IBTRIEN,XX)
. W !,"Entry #",ENTNUM," has been deleted."
I XX<0 Q XX
I XX=0 D Q $S($O(RETIEN(0)):RETIEN($O(RETIEN(0))),1:XX)
. S XX=NIEN
. S IBNEW=1
. S FDA(356.2216,"+1,"_IBTRIEN_",",.01)=NIEN
. D UPDATE^DIE("","FDA","RETIEN") ; File the new line
Q $P(SLDATA(XX),"^",1)
;
GETSELLN(CNT,IBTRIEN,IEN,H1,H2) ; Gets a line of information to display a
; Service Line
; Input: CNT - Current line Count
; IBTRIEN - IEN of the entry
; IEN - IEN of the Service Line
; IBTRF - 1 - Being called from the brief form
; Output: H1 - 1st Header display line
; H2 - 2nd Header display line
; Returns: Service line display
N FILE,N4,XX,YY,ZZ
; IBTRBRF is defined in IB CREATE 278 REQUEST SHORT input template
I $G(IBTRBRF)'=1 D
. S H1="# Type Proc Code Revenue Code Units/# of Procedures"
. S H2="-- ------ -------------------- ------------------- ---------------------"
I $G(IBTRBRF)=1 D
. S H1="# Proc Code "
. S H2="-- -------------------- "
S XX=$$LJ^XLFSTR(CNT,4) ; Selection #
I $G(IBTRBRF)'=1 D
. S YY=$$GET1^DIQ(356.2216,IEN_","_IBTRIEN_",",1.12,"I")
. S YY=$S(YY="P":"Prof",YY="I":"Inst",YY="D":"Dental",1:"")
. S XX=XX_$$LJ^XLFSTR(YY,6)_" "
S ZZ=$$GET1^DIQ(356.2216,IEN_","_IBTRIEN_",",1.01,"I") ; Procedure Coding Method
S N4=$S(ZZ="N4":1,1:0)
S:'N4 YY=$$GET1^DIQ(356.2216,IEN_","_IBTRIEN_",",1.02) ; Procedure Code
S:N4 YY=$$GET1^DIQ(356.2216,IEN_","_IBTRIEN_",",12.01) ; N4 Procedure Code
S XX=XX_$$LJ^XLFSTR(YY,"20T")_" "
I $G(IBTRBRF)'=1 D
. S YY=$$GET1^DIQ(356.2216,IEN_","_IBTRIEN_",",2.06,"I") ; Revenue Code IEN
. S YY=$$GET1^DIQ(399.2,YY_",",.01,"I") ; Revenue Code
. S XX=XX_$$LJ^XLFSTR(YY,"20T")_" "
. S YY=$$GET1^DIQ(356.2216,IEN_","_IBTRIEN_",",1.1) ; Units
. S ZZ=$$GET1^DIQ(356.2216,IEN_","_IBTRIEN_",",1.11) ; Unit Count
. S YY=ZZ_" "_YY
. S XX=XX_$$LJ^XLFSTR(YY,"21")
Q XX
;
DELSL(IBTRIEN,IEN) ; Checks to see if the user entered 'NEW' to create a new
; Service Line and didn't enter any data for it OR selected a service line
; to be deleted. If so, the Service Line with no data (or selected) is deleted
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; IEN - Optional, IEN of the multiple to be deleted if passed
; defaults to ""
; Output: Empty or selected Service line is deleted (Potentially)
N DA,DATA,DIK,LIEN,X,XX,Y,YY
S:'$D(IEN) IEN=""
I IEN'="" D Q
. S DA(1)=IBTRIEN,DA=IEN
. S DIK="^IBT(356.22,DA(1),16,"
. D ^DIK ; Delete the multiple
;
S LIEN=+$P($G(^IBT(356.22,IBTRIEN,16,0)),U,3) ; Last Multiple IEN
Q:'LIEN
S XX=$G(^IBT(356.22,IBTRIEN,16,LIEN,0))
S ($P(XX,U),$P(XX,U,11))="" ; Remove fields .01 and .11
Q:$TR(XX,U,"")'="" ; 0 node data exists
S XX=$G(^IBT(356.22,IBTRIEN,16,LIEN,1))
S $P(XX,U,12)="" ; Remove Service Line Type
S $P(XX,U)="" ; Remove Procedure Code Type
Q:$TR(XX,U,"")'="" ; 1 node data exists
S DATA=0
F YY=2:1:9 D Q:DATA
. S XX=$G(^IBT(356.22,IBTRIEN,16,LIEN,YY))
. S:$TR(XX,U,"")'="" DATA=1 ; 2-9 node data exists
Q:DATA
S DA(1)=IBTRIEN,DA=LIEN
S DIK="^IBT(356.22,DA(1),16,"
D ^DIK ; Delete the line
Q
;
SELSPD(IBTRIEN,SIEN) ;EP
; Called from within Input template IB CREATE 278 REQUEST
; Provides the user with a quick view of currently entered Service Line
; Provider Data multiples and allows them to select one to edit or enter a
; new one.
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; SIEN - Service Line Multiple IEN
; Returns: Value of the .01 field of the multiple to edit
; "" if creating a new multiple, -2 to exit multiple
; IBNEW=1 when creating a new entry
N CNT,ENTNUM,FDA,H1,H2,IEN,IENS,L1,L2,MAX,PDDATA,PTYPE,RETIEN,SECT,X,XX,Y,YY
S IBNEW=0,SECT="Service Provider Data Information"
;
; First check for an empty Provider Data Line to delete
D DELSPD(IBTRIEN,SIEN)
;
; Next create an array of all current Service Line Provider Data Information lines
S XX=+$P($G(^IBT(356.22,IBTRIEN,16,SIEN,8,0)),"^",4) ; Total # of multiples
S MAX=$S(XX<10:"",1:"Provider Data Lines")
S IEN=0,CNT=0
F D Q:+IEN=0
. S IEN=$O(^IBT(356.22,IBTRIEN,16,SIEN,8,IEN))
. Q:+IEN=0
. S CNT=CNT+1
. S XX=" "_$$LJ^XLFSTR(CNT,4) ; Selection #
. S IENS=IEN_","_SIEN_","_IBTRIEN_","
. S YY=$$GET1^DIQ(356.22168,IENS,.01) ; Prov Type Desc
. S XX=XX_$$LJ^XLFSTR(YY,"32T")
. S YY=$$GET1^DIQ(356.22168,IENS,.02) ; Person/Non-Person
. S XX=XX_$$LJ^XLFSTR(YY,12)
. S YY=$$GET1^DIQ(356.22168,IENS,.03) ; Provider Name
. S XX=XX_$$LJ^XLFSTR(YY,"30T")
. S PDDATA(CNT)=IEN_"^"_XX
;
I 'CNT D Q $S($O(RETIEN(0)):RETIEN($O(RETIEN(0))),1:XX)
. W !!," No Service Provider Data is currently on file.",!
. S XX=$$ASKNEW^IBTRH5D(" Add Service Provider Data Information","NO")
. Q:XX<0
. S PTYPE=$$PTYPE(IBTRIEN,SIEN) ; Get the .01 value
. I PTYPE="" S XX=-1 Q ; None entered
. S IBNEW=1,XX=PTYPE
. S FDA(356.22168,"+1,"_SIEN_","_IBTRIEN_",",.01)=PTYPE
. D UPDATE^DIE("","FDA","RETIEN") ; File the new line
;
; Next display all of the current Service Line Provider Data lines
S H1=" # Provider Type Per/Non Provider"
S H2=" -- ------------------------------ ---------- ------------------------------"
S L1=" The following Provider Data Information is currently on file."
S L2=" Enter the # of an entry to edit, 'NEW' to add one or press Return to skip."
S XX=$$SELENT^IBTRH5D(.PDDATA,H1,H2,L1,L2,MAX,1,SECT)
I XX?1"D".N D Q -3
. S (XX,ENTNUM)=$P(XX,"D",2)
. S XX=$P(PDDATA(XX),"^",1)
. D DELSPD(IBTRIEN,SIEN,XX)
. W !,"Entry #",ENTNUM," has been deleted."
I XX<0 Q XX
I XX=0 D Q $S($O(RETIEN(0)):RETIEN($O(RETIEN(0))),1:XX)
. S PTYPE=$$PTYPE(IBTRIEN,SIEN) ; Get the .01 value
. I PTYPE="" S XX=-1 Q ; None entered
. S XX=PTYPE
. S IBNEW=1
. ;
. ; NOTE: the code below had "+1," which doesn't work, don't change back
. S FDA(356.22168,"+2,"_SIEN_","_IBTRIEN_",",.01)=PTYPE
. D UPDATE^DIE("","FDA","RETIEN") ; File the new line
Q $P(PDDATA(XX),"^",1)
;
DELSPD(IBTRIEN,SIEN,IEN) ; Checks to see if the user entered 'NEW' to create a new
; Service Provider Data Line and didn't enter any data for it or selected a line
; to delete . If so, the Service Provider Data line with no data (or selectd) is deleted
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; SIEN - IEN of the Service Line
; IEN - Optional, IEN of the multiple to be deleted if passed
; defaults to ""
; Output: Empty OR selected Service Provider Data Line is deleted (Potentially)
N PDIEN,DA,DIK,X,XX,Y
S:'$D(IEN) IEN=""
I IEN'="" D Q
. S DA(2)=IBTRIEN,DA(1)=SIEN,DA=IEN
. S DIK="^IBT(356.22,DA(2),16,DA(1),8,"
. D ^DIK ; Delete the multiple
S PDIEN=+$P($G(^IBT(356.22,IBTRIEN,16,SIEN,8,0)),"^",3) ; Last Multiple IEN
Q:'PDIEN
S XX=$G(^IBT(356.22,IBTRIEN,16,SIEN,8,PDIEN,0))
S $P(XX,"^",1)="" ; Remove .01 field
Q:$TR(XX,"^","")'="" ; 0 node data exists
S DA(2)=IBTRIEN,DA(1)=SIEN,DA=PDIEN
S DIK="^IBT(356.22,DA(2),16,DA(1),8,"
D ^DIK ; Delete the multiple
Q
;
PTYPE(IBTRIEN,SIEN) ; Prompts the user to enter the .01 (Provider Type) field
; of the Provider Data multiple
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; SIEN - IEN of the Service Line
; Returns: IEN of the selected Provider Type or "" of not entered
N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DA(1)=IBTRIEN
S DIR(0)="356.22168,.01",DIR("A")=" Provider Type"
D ^DIR
Q:$D(DIRUT) ""
Q $P(Y,"^",1)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRH5E 16054 printed Apr 09, 2024@21:28:24 Page 2
IBTRH5E ;ALB/FA - HCSR Create 278 Request ;12-AUG-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 ; SELSL - Allows the user to see a quick view of the currently entered
+9 ; Service Lines and either pick one to edit, enter a new one or
+10 ; skip.
+11 ; SELOU - Allows the user to see a quick view of the currently entered
+12 ; Other UMO Information and either pick one to edit, enter a
+13 ; new one or skip.
+14 ; SELSPD - Allows the user to see a quick view of the currently entered
+15 ; Service Line Provider Data Lines and either pick one to edit,
+16 ; enter a new one or skip.
+17 ;-----------------------------------------------------------------------------
+18 ;
SELOU(IBTRIEN) ;EP
+1 ; Called from within Input template IB CREATE 278 REQUEST
+2 ; Provides the user with a quick view of currently entered Other UMO
+3 ; Information multiples and allows them to select one to edit or enter a new
+4 ; one.
+5 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+6 ; Returns: Value of the .01 field of the multiple to edit
+7 ; "" if creating a new multiple, -2 to exit template
+8 ; IBNEW=1 when creating a new entry
+9 NEW CNT,ENTNUM,FDA,IEN,H1,H2,L1,L2,OUDATA,OUTYPE,MAX,RETIEN,SECT,X,XX,Y,YY
+10 SET IBNEW=0
SET SECT="Other UMO Information"
+11 ;
+12 ; First check for an empty Other UMO Information Lines to delete
+13 DO DELOU(IBTRIEN)
+14 ;
+15 ; Next create an array of all current Other UMO Information lines
+16 ; Total # of multiples
SET XX=+$PIECE($GET(^IBT(356.22,IBTRIEN,15,0)),"^",4)
+17 SET MAX=$SELECT(XX<3:"",1:"Other UMO Information Lines")
+18 SET IEN=0
SET CNT=0
+19 FOR
Begin DoDot:1
+20 SET IEN=$ORDER(^IBT(356.22,IBTRIEN,15,IEN))
+21 if +IEN=0
QUIT
+22 SET CNT=CNT+1
+23 ; Selection #
SET XX=$$LJ^XLFSTR(CNT,4)
+24 ; UMO Type
SET YY=$$GET1^DIQ(356.2215,IEN_","_DA_",",.01)
+25 SET YY=$EXTRACT(YY,1,30)_" "
+26 SET XX=XX_$$LJ^XLFSTR(YY,32)
+27 ; UMO Name
SET YY=$$GET1^DIQ(356.2215,IEN_","_DA_",",.02)
+28 SET XX=XX_$$LJ^XLFSTR(YY,"44T")
+29 SET OUDATA(CNT)=IEN_"^"_XX
End DoDot:1
if +IEN=0
QUIT
+30 ;
+31 ; Creating 1st Other UMO Information Line?
+32 IF 'CNT
Begin DoDot:1
+33 WRITE !!,"No Other UMO Information is currently on file.",!
+34 SET XX=$$ASKNEW^IBTRH5D("Add Other UMO Information","NO")
+35 if XX<0
QUIT
+36 ; Get the .01 value
SET OUTYPE=$$OUTYPE(IBTRIEN)
+37 ; None entered
IF OUTYPE=""
SET XX=-1
QUIT
+38 SET IBNEW=1
SET XX=OUTYPE
+39 SET FDA(356.2215,"+1,"_IBTRIEN_",",.01)=OUTYPE
+40 ; File the new line
DO UPDATE^DIE("","FDA","RETIEN")
End DoDot:1
QUIT $SELECT($ORDER(RETIEN(0)):RETIEN($ORDER(RETIEN(0))),1:XX)
+41 ;
+42 ; Next display all of the current Other UMO Information
+43 SET H1="# Type UMO Name"
+44 SET H2="-- ------------------------------ ------------------------------"
+45 SET L1="The following Other UMO Information is currently on file."
+46 SET L2="Enter the # of an entry to edit, 'NEW' to add one or press Return to skip."
+47 SET XX=$$SELENT^IBTRH5D(.OUDATA,H1,H2,L1,L2,MAX,"",SECT)
+48 IF XX?1"D".N
Begin DoDot:1
+49 SET (XX,ENTNUM)=$PIECE(XX,"D",2)
+50 SET XX=$PIECE(OUDATA(XX),U)
+51 DO DELOU(IBTRIEN,XX)
+52 WRITE !,"Entry #",ENTNUM," has been deleted."
End DoDot:1
QUIT -3
+53 ;
+54 IF XX<0
QUIT XX
+55 IF XX=0
Begin DoDot:1
+56 ; Get the .01 value
SET OUTYPE=$$OUTYPE(IBTRIEN)
+57 ; None entered
IF OUTYPE=""
SET XX=-1
QUIT
+58 SET IBNEW=1
+59 SET XX=OUTYPE
+60 SET FDA(356.2215,"+1,"_IBTRIEN_",",.01)=OUTYPE
+61 ; File the new line
DO UPDATE^DIE("","FDA","RETIEN")
End DoDot:1
QUIT $SELECT($ORDER(RETIEN(0)):RETIEN($ORDER(RETIEN(0))),1:XX)
+62 QUIT $PIECE(OUDATA(XX),"^",1)
+63 ;
OUTYPE(IBTRIEN) ; Prompts the user to enter the .01 (Entity Identifier) field
+1 ; of the Other UMO Information Multiple
+2 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+3 ; Returns: Selected Entity Identifier or "" of not entered
+4 NEW ARR,DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,EIS,ERR,IX,X,XX,YY
+5 SET EIS=""
SET IX=0
+6 FOR
Begin DoDot:1
+7 SET IX=$ORDER(^IBT(356.22,IBTRIEN,15,IX))
+8 if +IX=0
QUIT
+9 SET XX=$PIECE(^IBT(356.22,IBTRIEN,15,IX,0),"^",1)
+10 SET EIS=$SELECT(EIS="":XX,1:EIS_"^"_XX)
End DoDot:1
if '+IX
QUIT
+11 SET DA(1)=IBTRIEN
+12 if EIS'=""
SET EIS="^"_EIS_"^"
+13 DO FIELD^DID(356.2215,.01,,"POINTER","ARR","ERR")
+14 SET DIR("A")=" Other UMO Qualifier: "
+15 SET XX=""
+16 FOR IX=1:1:$LENGTH(ARR("POINTER"),";")
Begin DoDot:1
+17 SET YY=$PIECE(ARR("POINTER"),";",IX)
+18 if EIS[("^"_$PIECE(YY,"
QUIT
+19 SET XX=$SELECT(XX="":YY,1:XX_";"_YY)
End DoDot:1
+20 SET DIR(0)="SOA^"_XX
+21 DO ^DIR
+22 if $DATA(DIRUT)
QUIT ""
+23 QUIT $PIECE(Y,"^",1)
+24 ;
DELOU(IBTRIEN,IEN) ; Checks to see if the user entered 'NEW' to create a new
+1 ; Other UMO Information Line and didn't enter any data for it OR selected a
+2 ; line to be deleted. If so, the Other Information Line with no data (or'
+3 ; selected) is deleted
+4 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+5 ; IEN - Optional, IEN of the multiple to be deleted if passed
+6 ; defaults to ""
+7 ; Output: Empty or selected Other UMO Information line is deleted (Potentially)
+8 NEW DA,DIK,OUIEN,X,XX,Y
+9 if '$DATA(IEN)
SET IEN=""
+10 IF IEN'=""
Begin DoDot:1
+11 SET DA(1)=IBTRIEN
SET DA=IEN
+12 SET DIK="^IBT(356.22,DA(1),15,"
+13 ; Delete the multiple
DO ^DIK
End DoDot:1
QUIT
+14 ;
+15 ; Last Multiple IEN
SET OUIEN=+$PIECE($GET(^IBT(356.22,IBTRIEN,15,0)),"^",3)
+16 if 'OUIEN
QUIT
+17 SET XX=$GET(^IBT(356.22,IBTRIEN,15,OUIEN,0))
+18 ; Remove .01 field
SET $PIECE(XX,"^",1)=""
+19 ; 0 node data exists
if $TRANSLATE(XX,"^","")'=""
QUIT
+20 SET DA(1)=IBTRIEN
SET DA=OUIEN
+21 SET DIK="^IBT(356.22,DA(1),15,"
+22 ; Delete the multiple
DO ^DIK
+23 QUIT
+24 ;
SELSL(IBTRIEN) ;EP
+1 ; Called from within Input template IB CREATE 278 REQUEST
+2 ; Provides the user with a quick view of currently entered Service Lines and
+3 ; allows them to select one to edit or enter a new Service Line.
+4 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+5 ; IBTRF - 1 - Being called from the brief form
+6 ; Returns: Value of the .01 field of the multiple to edit
+7 ; "" if creating a new multiple
+8 ; -1 if skipping altogether
+9 ; -2 to exit template
+10 ; IBNEW=1 when creating a new entry
+11 NEW CNT,ENTNUM,FDA,H1,H2,IEN,L1,L2,NIEN,RETIEN,SECT,SLDATA,X,XX,Y
+12 SET IBNEW=0
SET SECT="Service Line Detail"
+13 ;
+14 ; First check for an empty Service Line to delete
+15 DO DELSL(IBTRIEN)
+16 ;
+17 ; Next create an array of all current Service Lines
+18 ; Next Multiple IEN
SET NIEN=+$PIECE($GET(^IBT(356.22,IBTRIEN,16,0)),"^",3)+1
+19 SET IEN=0
SET CNT=0
+20 FOR
Begin DoDot:1
+21 SET IEN=$ORDER(^IBT(356.22,IBTRIEN,16,IEN))
+22 if +IEN=0
QUIT
+23 SET CNT=CNT+1
+24 ; Format Service line for display
SET XX=$$GETSELLN(CNT,IBTRIEN,IEN,.H1,.H2)
+25 SET SLDATA(CNT)=IEN_"^"_XX
End DoDot:1
if +IEN=0
QUIT
+26 ;
+27 ; Creating 1st Service Line?
+28 IF 'CNT
Begin DoDot:1
+29 IF $GET(IBTRBRF)'=1
Begin DoDot:2
+30 WRITE !!,"No Service Line Detail is currently on file.",!
+31 SET XX=$$ASKNEW^IBTRH5D("Add a new Service Line")
+32 QUIT
End DoDot:2
+33 IF $GET(IBTRBRF)=1
SET XX=0
+34 if XX<0
QUIT
+35 SET IBNEW=1
SET XX=NIEN
+36 SET FDA(356.2216,"+1,"_IBTRIEN_",",.01)=NIEN
+37 ; File the new line
DO UPDATE^DIE("","FDA","RETIEN")
+38 QUIT
End DoDot:1
QUIT $SELECT($ORDER(RETIEN(0)):RETIEN($ORDER(RETIEN(0))),1:XX)
+39 ;
+40 ; Next display all of the current Service Lines and let the user select one
+41 SET L1="The following Service Lines are currently on file."
+42 SET L2="Enter the # of a line to edit, 'NEW' to add one or press Return to skip."
+43 SET XX=$$SELENT^IBTRH5D(.SLDATA,H1,H2,L1,L2,"",SECT)
+44 IF XX?1"D".N
Begin DoDot:1
+45 SET (XX,ENTNUM)=$PIECE(XX,"D",2)
+46 SET XX=$PIECE(SLDATA(XX),"^",1)
+47 DO DELSL(IBTRIEN,XX)
+48 WRITE !,"Entry #",ENTNUM," has been deleted."
End DoDot:1
QUIT -3
+49 IF XX<0
QUIT XX
+50 IF XX=0
Begin DoDot:1
+51 SET XX=NIEN
+52 SET IBNEW=1
+53 SET FDA(356.2216,"+1,"_IBTRIEN_",",.01)=NIEN
+54 ; File the new line
DO UPDATE^DIE("","FDA","RETIEN")
End DoDot:1
QUIT $SELECT($ORDER(RETIEN(0)):RETIEN($ORDER(RETIEN(0))),1:XX)
+55 QUIT $PIECE(SLDATA(XX),"^",1)
+56 ;
GETSELLN(CNT,IBTRIEN,IEN,H1,H2) ; Gets a line of information to display a
+1 ; Service Line
+2 ; Input: CNT - Current line Count
+3 ; IBTRIEN - IEN of the entry
+4 ; IEN - IEN of the Service Line
+5 ; IBTRF - 1 - Being called from the brief form
+6 ; Output: H1 - 1st Header display line
+7 ; H2 - 2nd Header display line
+8 ; Returns: Service line display
+9 NEW FILE,N4,XX,YY,ZZ
+10 ; IBTRBRF is defined in IB CREATE 278 REQUEST SHORT input template
+11 IF $GET(IBTRBRF)'=1
Begin DoDot:1
+12 SET H1="# Type Proc Code Revenue Code Units/# of Procedures"
+13 SET H2="-- ------ -------------------- ------------------- ---------------------"
End DoDot:1
+14 IF $GET(IBTRBRF)=1
Begin DoDot:1
+15 SET H1="# Proc Code "
+16 SET H2="-- -------------------- "
End DoDot:1
+17 ; Selection #
SET XX=$$LJ^XLFSTR(CNT,4)
+18 IF $GET(IBTRBRF)'=1
Begin DoDot:1
+19 SET YY=$$GET1^DIQ(356.2216,IEN_","_IBTRIEN_",",1.12,"I")
+20 SET YY=$SELECT(YY="P":"Prof",YY="I":"Inst",YY="D":"Dental",1:"")
+21 SET XX=XX_$$LJ^XLFSTR(YY,6)_" "
End DoDot:1
+22 ; Procedure Coding Method
SET ZZ=$$GET1^DIQ(356.2216,IEN_","_IBTRIEN_",",1.01,"I")
+23 SET N4=$SELECT(ZZ="N4":1,1:0)
+24 ; Procedure Code
if 'N4
SET YY=$$GET1^DIQ(356.2216,IEN_","_IBTRIEN_",",1.02)
+25 ; N4 Procedure Code
if N4
SET YY=$$GET1^DIQ(356.2216,IEN_","_IBTRIEN_",",12.01)
+26 SET XX=XX_$$LJ^XLFSTR(YY,"20T")_" "
+27 IF $GET(IBTRBRF)'=1
Begin DoDot:1
+28 ; Revenue Code IEN
SET YY=$$GET1^DIQ(356.2216,IEN_","_IBTRIEN_",",2.06,"I")
+29 ; Revenue Code
SET YY=$$GET1^DIQ(399.2,YY_",",.01,"I")
+30 SET XX=XX_$$LJ^XLFSTR(YY,"20T")_" "
+31 ; Units
SET YY=$$GET1^DIQ(356.2216,IEN_","_IBTRIEN_",",1.1)
+32 ; Unit Count
SET ZZ=$$GET1^DIQ(356.2216,IEN_","_IBTRIEN_",",1.11)
+33 SET YY=ZZ_" "_YY
+34 SET XX=XX_$$LJ^XLFSTR(YY,"21")
End DoDot:1
+35 QUIT XX
+36 ;
DELSL(IBTRIEN,IEN) ; Checks to see if the user entered 'NEW' to create a new
+1 ; Service Line and didn't enter any data for it OR selected a service line
+2 ; to be deleted. If so, the Service Line with no data (or selected) is deleted
+3 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+4 ; IEN - Optional, IEN of the multiple to be deleted if passed
+5 ; defaults to ""
+6 ; Output: Empty or selected Service line is deleted (Potentially)
+7 NEW DA,DATA,DIK,LIEN,X,XX,Y,YY
+8 if '$DATA(IEN)
SET IEN=""
+9 IF IEN'=""
Begin DoDot:1
+10 SET DA(1)=IBTRIEN
SET DA=IEN
+11 SET DIK="^IBT(356.22,DA(1),16,"
+12 ; Delete the multiple
DO ^DIK
End DoDot:1
QUIT
+13 ;
+14 ; Last Multiple IEN
SET LIEN=+$PIECE($GET(^IBT(356.22,IBTRIEN,16,0)),U,3)
+15 if 'LIEN
QUIT
+16 SET XX=$GET(^IBT(356.22,IBTRIEN,16,LIEN,0))
+17 ; Remove fields .01 and .11
SET ($PIECE(XX,U),$PIECE(XX,U,11))=""
+18 ; 0 node data exists
if $TRANSLATE(XX,U,"")'=""
QUIT
+19 SET XX=$GET(^IBT(356.22,IBTRIEN,16,LIEN,1))
+20 ; Remove Service Line Type
SET $PIECE(XX,U,12)=""
+21 ; Remove Procedure Code Type
SET $PIECE(XX,U)=""
+22 ; 1 node data exists
if $TRANSLATE(XX,U,"")'=""
QUIT
+23 SET DATA=0
+24 FOR YY=2:1:9
Begin DoDot:1
+25 SET XX=$GET(^IBT(356.22,IBTRIEN,16,LIEN,YY))
+26 ; 2-9 node data exists
if $TRANSLATE(XX,U,"")'=""
SET DATA=1
End DoDot:1
if DATA
QUIT
+27 if DATA
QUIT
+28 SET DA(1)=IBTRIEN
SET DA=LIEN
+29 SET DIK="^IBT(356.22,DA(1),16,"
+30 ; Delete the line
DO ^DIK
+31 QUIT
+32 ;
SELSPD(IBTRIEN,SIEN) ;EP
+1 ; Called from within Input template IB CREATE 278 REQUEST
+2 ; Provides the user with a quick view of currently entered Service Line
+3 ; Provider Data multiples and allows them to select one to edit or enter a
+4 ; new one.
+5 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+6 ; SIEN - Service Line Multiple IEN
+7 ; Returns: Value of the .01 field of the multiple to edit
+8 ; "" if creating a new multiple, -2 to exit multiple
+9 ; IBNEW=1 when creating a new entry
+10 NEW CNT,ENTNUM,FDA,H1,H2,IEN,IENS,L1,L2,MAX,PDDATA,PTYPE,RETIEN,SECT,X,XX,Y,YY
+11 SET IBNEW=0
SET SECT="Service Provider Data Information"
+12 ;
+13 ; First check for an empty Provider Data Line to delete
+14 DO DELSPD(IBTRIEN,SIEN)
+15 ;
+16 ; Next create an array of all current Service Line Provider Data Information lines
+17 ; Total # of multiples
SET XX=+$PIECE($GET(^IBT(356.22,IBTRIEN,16,SIEN,8,0)),"^",4)
+18 SET MAX=$SELECT(XX<10:"",1:"Provider Data Lines")
+19 SET IEN=0
SET CNT=0
+20 FOR
Begin DoDot:1
+21 SET IEN=$ORDER(^IBT(356.22,IBTRIEN,16,SIEN,8,IEN))
+22 if +IEN=0
QUIT
+23 SET CNT=CNT+1
+24 ; Selection #
SET XX=" "_$$LJ^XLFSTR(CNT,4)
+25 SET IENS=IEN_","_SIEN_","_IBTRIEN_","
+26 ; Prov Type Desc
SET YY=$$GET1^DIQ(356.22168,IENS,.01)
+27 SET XX=XX_$$LJ^XLFSTR(YY,"32T")
+28 ; Person/Non-Person
SET YY=$$GET1^DIQ(356.22168,IENS,.02)
+29 SET XX=XX_$$LJ^XLFSTR(YY,12)
+30 ; Provider Name
SET YY=$$GET1^DIQ(356.22168,IENS,.03)
+31 SET XX=XX_$$LJ^XLFSTR(YY,"30T")
+32 SET PDDATA(CNT)=IEN_"^"_XX
End DoDot:1
if +IEN=0
QUIT
+33 ;
+34 IF 'CNT
Begin DoDot:1
+35 WRITE !!," No Service Provider Data is currently on file.",!
+36 SET XX=$$ASKNEW^IBTRH5D(" Add Service Provider Data Information","NO")
+37 if XX<0
QUIT
+38 ; Get the .01 value
SET PTYPE=$$PTYPE(IBTRIEN,SIEN)
+39 ; None entered
IF PTYPE=""
SET XX=-1
QUIT
+40 SET IBNEW=1
SET XX=PTYPE
+41 SET FDA(356.22168,"+1,"_SIEN_","_IBTRIEN_",",.01)=PTYPE
+42 ; File the new line
DO UPDATE^DIE("","FDA","RETIEN")
End DoDot:1
QUIT $SELECT($ORDER(RETIEN(0)):RETIEN($ORDER(RETIEN(0))),1:XX)
+43 ;
+44 ; Next display all of the current Service Line Provider Data lines
+45 SET H1=" # Provider Type Per/Non Provider"
+46 SET H2=" -- ------------------------------ ---------- ------------------------------"
+47 SET L1=" The following Provider Data Information is currently on file."
+48 SET L2=" Enter the # of an entry to edit, 'NEW' to add one or press Return to skip."
+49 SET XX=$$SELENT^IBTRH5D(.PDDATA,H1,H2,L1,L2,MAX,1,SECT)
+50 IF XX?1"D".N
Begin DoDot:1
+51 SET (XX,ENTNUM)=$PIECE(XX,"D",2)
+52 SET XX=$PIECE(PDDATA(XX),"^",1)
+53 DO DELSPD(IBTRIEN,SIEN,XX)
+54 WRITE !,"Entry #",ENTNUM," has been deleted."
End DoDot:1
QUIT -3
+55 IF XX<0
QUIT XX
+56 IF XX=0
Begin DoDot:1
+57 ; Get the .01 value
SET PTYPE=$$PTYPE(IBTRIEN,SIEN)
+58 ; None entered
IF PTYPE=""
SET XX=-1
QUIT
+59 SET XX=PTYPE
+60 SET IBNEW=1
+61 ;
+62 ; NOTE: the code below had "+1," which doesn't work, don't change back
+63 SET FDA(356.22168,"+2,"_SIEN_","_IBTRIEN_",",.01)=PTYPE
+64 ; File the new line
DO UPDATE^DIE("","FDA","RETIEN")
End DoDot:1
QUIT $SELECT($ORDER(RETIEN(0)):RETIEN($ORDER(RETIEN(0))),1:XX)
+65 QUIT $PIECE(PDDATA(XX),"^",1)
+66 ;
DELSPD(IBTRIEN,SIEN,IEN) ; Checks to see if the user entered 'NEW' to create a new
+1 ; Service Provider Data Line and didn't enter any data for it or selected a line
+2 ; to delete . If so, the Service Provider Data line with no data (or selectd) is deleted
+3 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+4 ; SIEN - IEN of the Service Line
+5 ; IEN - Optional, IEN of the multiple to be deleted if passed
+6 ; defaults to ""
+7 ; Output: Empty OR selected Service Provider Data Line is deleted (Potentially)
+8 NEW PDIEN,DA,DIK,X,XX,Y
+9 if '$DATA(IEN)
SET IEN=""
+10 IF IEN'=""
Begin DoDot:1
+11 SET DA(2)=IBTRIEN
SET DA(1)=SIEN
SET DA=IEN
+12 SET DIK="^IBT(356.22,DA(2),16,DA(1),8,"
+13 ; Delete the multiple
DO ^DIK
End DoDot:1
QUIT
+14 ; Last Multiple IEN
SET PDIEN=+$PIECE($GET(^IBT(356.22,IBTRIEN,16,SIEN,8,0)),"^",3)
+15 if 'PDIEN
QUIT
+16 SET XX=$GET(^IBT(356.22,IBTRIEN,16,SIEN,8,PDIEN,0))
+17 ; Remove .01 field
SET $PIECE(XX,"^",1)=""
+18 ; 0 node data exists
if $TRANSLATE(XX,"^","")'=""
QUIT
+19 SET DA(2)=IBTRIEN
SET DA(1)=SIEN
SET DA=PDIEN
+20 SET DIK="^IBT(356.22,DA(2),16,DA(1),8,"
+21 ; Delete the multiple
DO ^DIK
+22 QUIT
+23 ;
PTYPE(IBTRIEN,SIEN) ; Prompts the user to enter the .01 (Provider Type) field
+1 ; of the Provider Data multiple
+2 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+3 ; SIEN - IEN of the Service Line
+4 ; Returns: IEN of the selected Provider Type or "" of not entered
+5 NEW DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+6 SET DA(1)=IBTRIEN
+7 SET DIR(0)="356.22168,.01"
SET DIR("A")=" Provider Type"
+8 DO ^DIR
+9 if $DATA(DIRUT)
QUIT ""
+10 QUIT $PIECE(Y,"^",1)
+11 ;
