IBTRH5F ;ALB/FA - HCSR Create 278 Request ;15-SEP-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 --------------------------------
; SELSAPI - Allows the user to see a quick view of the currently entered
; Service Line Additional Information Lines and either pick one
; to edit, enter a new one or skip.
; SELPT - Allows the user to see a quick view of the currently entered
; Patient Event Transport Lines and either pick one to edit,
; enter a new one or skip.
; SELSTI - Allows the user to see a quick view of the currently entered
; Service Line Tooth Information Lines and either pick one to
; edit, enter a new one or skip.
;-----------------------------------------------------------------------------
;
SELPT(IBTRIEN) ;EP
; Called from within Input template IB CREATE 278 REQUEST
; Provides the user with a quick view of currently entered Patient Transport
; 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,MAX,PT,PTDATA,PTTYPE,RETIEN,SECT,X,XX,Y,YY
S IBNEW=0,SECT="Patient Transport Information"
;
; First check for an empty Patient Transport Information Lines to delete
D DELPT(IBTRIEN)
;
; Next create an array of all current Patient Transport Information lines
S XX=+$P($G(^IBT(356.22,IBTRIEN,14,0)),"^",4) ; Total # of lines
S MAX=$S(XX<5:"",1:"Patient Transport Information Lines")
S SECT="Patient Transport Information"
S IEN=0,CNT=0
F D Q:+IEN=0
. S IEN=$O(^IBT(356.22,IBTRIEN,14,IEN))
. Q:+IEN=0
. S CNT=CNT+1
. S PT=$G(^IBT(356.22,IBTRIEN,14,IEN,0))
. S XX=$$LJ^XLFSTR(CNT,4) ; Selection #
. S YY=$$GET1^DIQ(356.2214,IEN_","_DA_",",.01)
. S YY=$E(YY,1,20)_" "
. S XX=XX_$$LJ^XLFSTR(YY,22)
. S YY=$$GET1^DIQ(356.2214,IEN_","_DA_",",.02)
. S XX=XX_$$LJ^XLFSTR(YY,"54T")
. S PTDATA(CNT)=IEN_"^"_XX
;
S H1="# Type Location Name"
S H2="-- -------------------- ------------------------------------------------------"
S L1="The following Patient Transport Information is currently on file."
S L2="Enter the # of an entry to edit, 'NEW' to add one or press Return to skip."
;
; Creating 1st Patient Transport Information Line
I CNT=0 D Q $O(RETIEN(0))
. W !!,"Two Patient Transport Information lines are required.",!
. S PTTYPE=$$PTTYPE(IBTRIEN,1) ; Get the .01 value
. S FDA(356.2214,"+1,"_IBTRIEN_",",.01)=PTTYPE
. D UPDATE^DIE("","FDA","RETIEN") ; File the new line
;
; Creating 2nd Patient Transport Information Line
I CNT=1 D Q $O(RETIEN(0))
. W !!,"Two Patient Transport Information lines are required.",!!
. W !,L1,!,H1,!,H2,!,$P(PTDATA(1),"^",2),!!
. S PTTYPE=$$PTTYPE(IBTRIEN,1) ; Get the .01 value
. S FDA(356.2214,"+2,"_IBTRIEN_",",.01)=PTTYPE
. D UPDATE^DIE("","FDA","RETIEN") ; File the new line
;
; Next display all of the current Patient Transport Lines
S XX=$$SELENT^IBTRH5D(.PTDATA,H1,H2,L1,L2,MAX,"",SECT)
I XX?1"D".N D Q -3
. S (XX,ENTNUM)=$P(XX,"D",2)
. S XX=$P(PTDATA(XX),"^",1)
. D DELPT(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 PTTYPE=$$PTTYPE(IBTRIEN) ; Get the .01 value
. I PTTYPE="" S XX=-1 Q ; None entered
. S IBNEW=1
. S XX=PTTYPE
. S FDA(356.2214,"+1,"_IBTRIEN_",",.01)=PTTYPE
. D UPDATE^DIE("","FDA","RETIEN") ; File the new line
Q $P(PTDATA(XX),"^",1)
;
PTTYPE(IBTRIEN,REQ) ; Prompts the user to enter the .01 (Entity Identifier) field
; of the Patient Transport Information Multiple
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; REQ - 1 if field is required
; Optional, defaults to 0
; Returns: Selected Entity Identifier or "" of not entered
N ARR,DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,EIS,ERR,IX,X,XX,YY
PTTYPE1 ; Looping tag
S:'$D(REQ) REQ=0
S EIS="",IX=0
F D Q:'+IX
. S IX=$O(^IBT(356.22,IBTRIEN,14,IX))
. Q:+IX=0
. S XX=$P(^IBT(356.22,IBTRIEN,14,IX,0),"^",1)
. S EIS=$S(EIS="":XX,1:EIS_"^"_XX)
S DA(1)=IBTRIEN
S:EIS'="" EIS="^"_EIS_"^"
D FIELD^DID(356.2214,.01,,"POINTER","ARR","ERR")
S DIR("A")=" Ambulance Location 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)=$S(REQ:"SA^",1:"SOA^")_XX
D ^DIR
I REQ,$D(DIRUT) D G PTTYPE1
. W !,*7," Entity Identifier is required.",!!
Q:$D(DIRUT) ""
Q $P(Y,"^",1)
;
DELPT(IBTRIEN,IEN) ; Checks to see if the user entered 'NEW' to create a new
; Patient Transport Information Line and didn't enter any data for it OR
; selected a line to delete. If so, the Patient Transport 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) Patient Transport Information line is deleted (Potentially)
N DA,DIK,PTIEN,X,XX,Y
S:'$D(IEN) IEN=""
I IEN'="" D Q
. S DA(1)=IBTRIEN,DA=IEN
. S DIK="^IBT(356.22,DA(1),14,"
. D ^DIK ; Delete the multiple
;
S PTIEN=+$P($G(^IBT(356.22,IBTRIEN,14,0)),"^",3) ; Last Multiple IEN
Q:'PTIEN
S XX=$G(^IBT(356.22,IBTRIEN,14,PTIEN,0))
S $P(XX,"^",1)="" ; Remove .01 field
Q:$TR(XX,"^","")'="" ; 0 node data exists
S DA(1)=IBTRIEN,DA=PTIEN
S DIK="^IBT(356.22,DA(1),14,"
D ^DIK ; Delete the multiple
Q
;
SELSAPI(IBTRIEN,SIEN) ;EP
; Called from within Input template IB CREATE 278 REQUEST
; Provides the user with a quick view of currently entered Service Line
; Additional Patient 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
; SIEN - IEN of the service line multiple being edited
; 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 AIDATA,CNT,ENTNUM,FDA,IEN,IENS,H1,H2,L1,L2,MAX,RETIEN,RTYPE,SECT,X,XX,Y,YY
S IBNEW=0,SECT="Service Additional Patient Information"
;
; First check for an empty Additional Patient Information Line to delete
D DELSAPI(IBTRIEN,SIEN)
;
; Next create an array of all current Additional Patient
; Information lines to display
S XX=+$P($G(^IBT(356.22,IBTRIEN,16,SIEN,6,0)),"^",4) ; Total # of API Lines
S MAX=$S(XX<10:"",1:"Additional Patient Information Lines")
S IEN=0,CNT=0
F D Q:+IEN=0
. S IEN=$O(^IBT(356.22,IBTRIEN,16,SIEN,6,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.22166,IENS,.01) ; Report Type Desc
. S YY=$E(YY,1,26)_" "
. S XX=XX_$$LJ^XLFSTR(YY,28)
. S YY=$$GET1^DIQ(356.22166,IENS,.02) ; Delivery Method
. S YY=$E(YY,1,20)_" "
. S XX=XX_$$LJ^XLFSTR(YY,23)
. S YY=$$GET1^DIQ(356.22166,IENS,.03) ; Attachment Ctrl #
. S YY=$E(YY,1,22)
. S XX=XX_$$LJ^XLFSTR(YY,22)
. S AIDATA(CNT)=IEN_"^"_XX
;
I 'CNT D Q $S($O(RETIEN(0)):RETIEN($O(RETIEN(0))),1:XX)
. W !!," No Additional Patient Information is currently on file.",!
. S XX=$$ASKNEW^IBTRH5D(" Add Additional Patient Information","NO")
. Q:XX<0
. S RTYPE=$$RTYPE(IBTRIEN,SIEN) ; Get the .01 value
. I RTYPE="" S XX=-1 Q ; None entered
. S IBNEW=1,XX=RTYPE
. S FDA(356.22166,"+1,"_SIEN_","_IBTRIEN_",",.01)=RTYPE
. D UPDATE^DIE("","FDA","RETIEN") ; File the new line
;
; Next display all of the current Additional Patient Information
S H1=" # Report Type Delivery Method Attachment Control #"
S H2=" -- -------------------------- --------------------- ----------------------"
S L1=" The following Additional Patient 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(.AIDATA,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(AIDATA(XX),"^",1)
. D DELSAPI(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 RTYPE=$$RTYPE(IBTRIEN,SIEN) ; Get the .01 value
. I RTYPE="" S XX=-1 Q ; None entered
. S XX=RTYPE
. S IBNEW=1
. S FDA(356.22166,"+1,"_SIEN_","_IBTRIEN_",",.01)=RTYPE
. D UPDATE^DIE("","FDA","RETIEN") ; File the new line
Q $P(AIDATA(XX),"^",1)
;
DELSAPI(IBTRIEN,SIEN,IEN) ; Checks to see if the user entered 'NEW' to create a new
; Additional Patient Information Line and didn't enter any data for it or selected
; a line to be deleted. If so, the empty or selected Additional Patient Information
; line is deleted
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; SIEN - IEN of the Service Line being edited
; IEN - Optional, IEN of the multiple to be deleted if passed
; defaults to ""
; Output: Empty or selected Additional Patient Information line is deleted (Potentially)
N APIIEN,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),6,"
. D ^DIK ; Delete the multiple
;
S APIIEN=+$P($G(^IBT(356.22,IBTRIEN,16,SIEN,11,0)),"^",3) ; Last Multiple IEN
Q:'APIIEN
S XX=$G(^IBT(356.22,IBTRIEN,16,SIEN,6,APIIEN,0))
S $P(XX,"^",1)="" ; Remove .01 field
Q:$TR(XX,"^","")'="" ; 0 node data exists
S DA(2)=IBTRIEN,DA(1)=SIEN,DA=APIIEN
S DIK="^IBT(356.22,DA(2),16,DA(1),6,"
D ^DIK ; Delete the multiple
Q
;
RTYPE(IBTRIEN,SIEN) ; Prompts the user to enter the .01 (Report Type) field of the
; Additional Patient Information multiple
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; SIEN - IEN of the Service Line
; Returns: IEN of the selected Report Type or "" of not entered
N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DA(2)=IBTRIEN,DA(1)=SIEN
S DIR(0)="356.22166,.01",DIR("A")=" Report Type"
D ^DIR
Q:$D(DIRUT) ""
Q $P(Y,"^",1)
;
SELSTI(IBTRIEN,SIEN) ;EP
; Called from within Input template IB CREATE 278 REQUEST
; Provides the user with a quick view of currently entered Service Line Tooth
; 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
; 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,TDATA,IEN,H1,H2,IEN,IENS,L1,L2,MAX,RETIEN,SECT,TIDATA,TTYPE,X,XX,Y,YY
S IBNEW=0,SECT="Tooth Information"
;
; First check for an empty Additional Patient Information Line to delete
D DELSTI(IBTRIEN,SIEN)
;
; Next create an array of all current Service Line Tooth Information Lines
S XX=+$P($G(^IBT(356.22,IBTRIEN,16,SIEN,4,0)),"^",4) ; Total # of multiples
S MAX=$S(XX<32:"",1:"Tooth Information Lines")
S IEN=0,CNT=0
F D Q:+IEN=0
. S IEN=$O(^IBT(356.22,IBTRIEN,16,SIEN,4,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.22164,IENS,.01,"I") ; Tooth Code (External)
. S YY=$$GET1^DIQ(356.022,YY_",",.01) ; Tooth Code
. S XX=XX_$$LJ^XLFSTR(YY,7)
. S YY=$$GET1^DIQ(356.22164,IENS,.02) ; Tooth Surface #1
. S XX=XX_$$LJ^XLFSTR(YY,12)
. S YY=$$GET1^DIQ(356.22164,IENS,.03) ; Tooth Surface #2
. S XX=XX_$$LJ^XLFSTR(YY,12)
. S YY=$$GET1^DIQ(356.22164,IENS,.04) ; Tooth Surface #3
. S XX=XX_$$LJ^XLFSTR(YY,12)
. S YY=$$GET1^DIQ(356.22164,IENS,.05) ; Tooth Surface #4
. S XX=XX_$$LJ^XLFSTR(YY,12)
. S TIDATA(CNT)=IEN_"^"_XX
;
I 'CNT D Q $S($O(RETIEN(0)):RETIEN($O(RETIEN(0))),1:XX)
. W !!," No Additional Patient Information is currently on file.",!
. S XX=$$ASKNEW^IBTRH5D(" Add Tooth Information")
. Q:XX<0
. S TTYPE=$$TTYPE(IBTRIEN,SIEN) ; Get the .01 value
. I TTYPE="" S XX=-1 Q ; None entered
. S IBNEW=1,XX=TTYPE
. S FDA(356.22164,"+1,"_SIEN_","_IBTRIEN_",",.01)=TTYPE
. D UPDATE^DIE("","FDA","RETIEN") ; File the new line
;
; Next display all of the current Tooth Information lines and let the user select one
S H1=" # Tooth Surface #1 Surface #2 Surface #3 Surface #4"
S H2=" -- ----- ---------- ---------- ---------- ----------"
S L1=" The following Tooth Information 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(.TIDATA,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(TIDATA(XX),"^",1)
. D DELSTI(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 TTYPE=$$TTYPE(IBTRIEN,SIEN) ; Get the .01 value
. I TTYPE="" S XX=-1 Q ; None entered
. S IBNEW=1
. S XX=TTYPE
. S FDA(356.22164,"+1,"_SIEN_","_IBTRIEN_",",.01)=TTYPE
. D UPDATE^DIE("","FDA","RETIEN") ; File the new line
Q $P(TIDATA(XX),"^",1)
;
DELSTI(IBTRIEN,SIEN,IEN) ; Checks to see if the user entered 'NEW' to create a new
; Tooth Information Line and didn't enter any data for it OR selected a line
; to be deleted. If so, the Additional Tooth Information line with no data
; (or selected) is deleted
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; SIEN - IEN of the Service Line being edited
; Output: Empty (or selected) Tooth Information line is deleted (Potentially)
N DA,DIK,TIIEN,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),4,"
. D ^DIK ; Delete the multiple
;
S TIIEN=+$P($G(^IBT(356.22,IBTRIEN,16,SIEN,4,0)),"^",3) ; Last Multiple IEN
Q:'TIIEN
S XX=$G(^IBT(356.22,IBTRIEN,16,SIEN,4,TIIEN,0))
S $P(XX,"^",1)="" ; Remove .01 field
Q:$TR(XX,"^","")'="" ; 0 node data exists
S DA(2)=IBTRIEN,DA(1)=SIEN,DA=TIIEN
S DIK="^IBT(356.22,DA(2),16,DA(1),4,"
D ^DIK ; Delete the multiple
Q
;
TTYPE(IBTRIEN,SIEN) ; Prompts the user to enter the .01 (Tooth) field of the
; Tooth Information multiple
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; SIEN - IEN of the Service Line
; Returns: IEN of the selected Tooth Type or "" of not entered
N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DA(2)=IBTRIEN,DA(1)=SIEN
S DIR(0)="356.22164,.01",DIR("A")=" Tooth Code"
D ^DIR
Q:$D(DIRUT) ""
Q $P(Y,"^",1)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRH5F 16157 printed Apr 09, 2024@21:36:28 Page 2
IBTRH5F ;ALB/FA - HCSR Create 278 Request ;15-SEP-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 ; SELSAPI - Allows the user to see a quick view of the currently entered
+9 ; Service Line Additional Information Lines and either pick one
+10 ; to edit, enter a new one or skip.
+11 ; SELPT - Allows the user to see a quick view of the currently entered
+12 ; Patient Event Transport Lines and either pick one to edit,
+13 ; enter a new one or skip.
+14 ; SELSTI - Allows the user to see a quick view of the currently entered
+15 ; Service Line Tooth Information Lines and either pick one to
+16 ; edit, enter a new one or skip.
+17 ;-----------------------------------------------------------------------------
+18 ;
SELPT(IBTRIEN) ;EP
+1 ; Called from within Input template IB CREATE 278 REQUEST
+2 ; Provides the user with a quick view of currently entered Patient Transport
+3 ; multiples and allows them to select one to edit or enter a new one.
+4 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+5 ; Returns: Value of the .01 field of the multiple to edit
+6 ; "" if creating a new multiple, -2 to exit template
+7 ; IBNEW=1 when creating a new entry
+8 NEW CNT,ENTNUM,FDA,IEN,H1,H2,L1,L2,MAX,PT,PTDATA,PTTYPE,RETIEN,SECT,X,XX,Y,YY
+9 SET IBNEW=0
SET SECT="Patient Transport Information"
+10 ;
+11 ; First check for an empty Patient Transport Information Lines to delete
+12 DO DELPT(IBTRIEN)
+13 ;
+14 ; Next create an array of all current Patient Transport Information lines
+15 ; Total # of lines
SET XX=+$PIECE($GET(^IBT(356.22,IBTRIEN,14,0)),"^",4)
+16 SET MAX=$SELECT(XX<5:"",1:"Patient Transport Information Lines")
+17 SET SECT="Patient Transport Information"
+18 SET IEN=0
SET CNT=0
+19 FOR
Begin DoDot:1
+20 SET IEN=$ORDER(^IBT(356.22,IBTRIEN,14,IEN))
+21 if +IEN=0
QUIT
+22 SET CNT=CNT+1
+23 SET PT=$GET(^IBT(356.22,IBTRIEN,14,IEN,0))
+24 ; Selection #
SET XX=$$LJ^XLFSTR(CNT,4)
+25 SET YY=$$GET1^DIQ(356.2214,IEN_","_DA_",",.01)
+26 SET YY=$EXTRACT(YY,1,20)_" "
+27 SET XX=XX_$$LJ^XLFSTR(YY,22)
+28 SET YY=$$GET1^DIQ(356.2214,IEN_","_DA_",",.02)
+29 SET XX=XX_$$LJ^XLFSTR(YY,"54T")
+30 SET PTDATA(CNT)=IEN_"^"_XX
End DoDot:1
if +IEN=0
QUIT
+31 ;
+32 SET H1="# Type Location Name"
+33 SET H2="-- -------------------- ------------------------------------------------------"
+34 SET L1="The following Patient Transport Information is currently on file."
+35 SET L2="Enter the # of an entry to edit, 'NEW' to add one or press Return to skip."
+36 ;
+37 ; Creating 1st Patient Transport Information Line
+38 IF CNT=0
Begin DoDot:1
+39 WRITE !!,"Two Patient Transport Information lines are required.",!
+40 ; Get the .01 value
SET PTTYPE=$$PTTYPE(IBTRIEN,1)
+41 SET FDA(356.2214,"+1,"_IBTRIEN_",",.01)=PTTYPE
+42 ; File the new line
DO UPDATE^DIE("","FDA","RETIEN")
End DoDot:1
QUIT $ORDER(RETIEN(0))
+43 ;
+44 ; Creating 2nd Patient Transport Information Line
+45 IF CNT=1
Begin DoDot:1
+46 WRITE !!,"Two Patient Transport Information lines are required.",!!
+47 WRITE !,L1,!,H1,!,H2,!,$PIECE(PTDATA(1),"^",2),!!
+48 ; Get the .01 value
SET PTTYPE=$$PTTYPE(IBTRIEN,1)
+49 SET FDA(356.2214,"+2,"_IBTRIEN_",",.01)=PTTYPE
+50 ; File the new line
DO UPDATE^DIE("","FDA","RETIEN")
End DoDot:1
QUIT $ORDER(RETIEN(0))
+51 ;
+52 ; Next display all of the current Patient Transport Lines
+53 SET XX=$$SELENT^IBTRH5D(.PTDATA,H1,H2,L1,L2,MAX,"",SECT)
+54 IF XX?1"D".N
Begin DoDot:1
+55 SET (XX,ENTNUM)=$PIECE(XX,"D",2)
+56 SET XX=$PIECE(PTDATA(XX),"^",1)
+57 DO DELPT(IBTRIEN,XX)
+58 WRITE !,"Entry #",ENTNUM," has been deleted."
End DoDot:1
QUIT -3
+59 IF XX<0
QUIT XX
+60 IF XX=0
Begin DoDot:1
+61 ; Get the .01 value
SET PTTYPE=$$PTTYPE(IBTRIEN)
+62 ; None entered
IF PTTYPE=""
SET XX=-1
QUIT
+63 SET IBNEW=1
+64 SET XX=PTTYPE
+65 SET FDA(356.2214,"+1,"_IBTRIEN_",",.01)=PTTYPE
+66 ; File the new line
DO UPDATE^DIE("","FDA","RETIEN")
End DoDot:1
QUIT $SELECT($ORDER(RETIEN(0)):RETIEN($ORDER(RETIEN(0))),1:XX)
+67 QUIT $PIECE(PTDATA(XX),"^",1)
+68 ;
PTTYPE(IBTRIEN,REQ) ; Prompts the user to enter the .01 (Entity Identifier) field
+1 ; of the Patient Transport Information Multiple
+2 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+3 ; REQ - 1 if field is required
+4 ; Optional, defaults to 0
+5 ; Returns: Selected Entity Identifier or "" of not entered
+6 NEW ARR,DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,EIS,ERR,IX,X,XX,YY
PTTYPE1 ; Looping tag
+1 if '$DATA(REQ)
SET REQ=0
+2 SET EIS=""
SET IX=0
+3 FOR
Begin DoDot:1
+4 SET IX=$ORDER(^IBT(356.22,IBTRIEN,14,IX))
+5 if +IX=0
QUIT
+6 SET XX=$PIECE(^IBT(356.22,IBTRIEN,14,IX,0),"^",1)
+7 SET EIS=$SELECT(EIS="":XX,1:EIS_"^"_XX)
End DoDot:1
if '+IX
QUIT
+8 SET DA(1)=IBTRIEN
+9 if EIS'=""
SET EIS="^"_EIS_"^"
+10 DO FIELD^DID(356.2214,.01,,"POINTER","ARR","ERR")
+11 SET DIR("A")=" Ambulance Location Qualifier: "
+12 SET XX=""
+13 FOR IX=1:1:$LENGTH(ARR("POINTER"),";")
Begin DoDot:1
+14 SET YY=$PIECE(ARR("POINTER"),";",IX)
+15 if EIS[("^"_$PIECE(YY,"
QUIT
+16 SET XX=$SELECT(XX="":YY,1:XX_";"_YY)
End DoDot:1
+17 SET DIR(0)=$SELECT(REQ:"SA^",1:"SOA^")_XX
+18 DO ^DIR
+19 IF REQ
IF $DATA(DIRUT)
Begin DoDot:1
+20 WRITE !,*7," Entity Identifier is required.",!!
End DoDot:1
GOTO PTTYPE1
+21 if $DATA(DIRUT)
QUIT ""
+22 QUIT $PIECE(Y,"^",1)
+23 ;
DELPT(IBTRIEN,IEN) ; Checks to see if the user entered 'NEW' to create a new
+1 ; Patient Transport Information Line and didn't enter any data for it OR
+2 ; selected a line to delete. If so, the Patient Transport Information Line with
+3 ; no data (or 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) Patient Transport Information line is deleted (Potentially)
+8 NEW DA,DIK,PTIEN,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),14,"
+13 ; Delete the multiple
DO ^DIK
End DoDot:1
QUIT
+14 ;
+15 ; Last Multiple IEN
SET PTIEN=+$PIECE($GET(^IBT(356.22,IBTRIEN,14,0)),"^",3)
+16 if 'PTIEN
QUIT
+17 SET XX=$GET(^IBT(356.22,IBTRIEN,14,PTIEN,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=PTIEN
+21 SET DIK="^IBT(356.22,DA(1),14,"
+22 ; Delete the multiple
DO ^DIK
+23 QUIT
+24 ;
SELSAPI(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 ; Additional Patient Information multiples and allows them to select one to
+4 ; edit or enter a new one.
+5 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+6 ; SIEN - IEN of the service line multiple being edited
+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 AIDATA,CNT,ENTNUM,FDA,IEN,IENS,H1,H2,L1,L2,MAX,RETIEN,RTYPE,SECT,X,XX,Y,YY
+11 SET IBNEW=0
SET SECT="Service Additional Patient Information"
+12 ;
+13 ; First check for an empty Additional Patient Information Line to delete
+14 DO DELSAPI(IBTRIEN,SIEN)
+15 ;
+16 ; Next create an array of all current Additional Patient
+17 ; Information lines to display
+18 ; Total # of API Lines
SET XX=+$PIECE($GET(^IBT(356.22,IBTRIEN,16,SIEN,6,0)),"^",4)
+19 SET MAX=$SELECT(XX<10:"",1:"Additional Patient Information Lines")
+20 SET IEN=0
SET CNT=0
+21 FOR
Begin DoDot:1
+22 SET IEN=$ORDER(^IBT(356.22,IBTRIEN,16,SIEN,6,IEN))
+23 if +IEN=0
QUIT
+24 SET CNT=CNT+1
+25 ; Selection #
SET XX=" "_$$LJ^XLFSTR(CNT,4)
+26 SET IENS=IEN_","_SIEN_","_IBTRIEN_","
+27 ; Report Type Desc
SET YY=$$GET1^DIQ(356.22166,IENS,.01)
+28 SET YY=$EXTRACT(YY,1,26)_" "
+29 SET XX=XX_$$LJ^XLFSTR(YY,28)
+30 ; Delivery Method
SET YY=$$GET1^DIQ(356.22166,IENS,.02)
+31 SET YY=$EXTRACT(YY,1,20)_" "
+32 SET XX=XX_$$LJ^XLFSTR(YY,23)
+33 ; Attachment Ctrl #
SET YY=$$GET1^DIQ(356.22166,IENS,.03)
+34 SET YY=$EXTRACT(YY,1,22)
+35 SET XX=XX_$$LJ^XLFSTR(YY,22)
+36 SET AIDATA(CNT)=IEN_"^"_XX
End DoDot:1
if +IEN=0
QUIT
+37 ;
+38 IF 'CNT
Begin DoDot:1
+39 WRITE !!," No Additional Patient Information is currently on file.",!
+40 SET XX=$$ASKNEW^IBTRH5D(" Add Additional Patient Information","NO")
+41 if XX<0
QUIT
+42 ; Get the .01 value
SET RTYPE=$$RTYPE(IBTRIEN,SIEN)
+43 ; None entered
IF RTYPE=""
SET XX=-1
QUIT
+44 SET IBNEW=1
SET XX=RTYPE
+45 SET FDA(356.22166,"+1,"_SIEN_","_IBTRIEN_",",.01)=RTYPE
+46 ; File the new line
DO UPDATE^DIE("","FDA","RETIEN")
End DoDot:1
QUIT $SELECT($ORDER(RETIEN(0)):RETIEN($ORDER(RETIEN(0))),1:XX)
+47 ;
+48 ; Next display all of the current Additional Patient Information
+49 SET H1=" # Report Type Delivery Method Attachment Control #"
+50 SET H2=" -- -------------------------- --------------------- ----------------------"
+51 SET L1=" The following Additional Patient Information is currently on file."
+52 SET L2=" Enter the # of an entry to edit, 'NEW' to add one or press Return to skip."
+53 SET XX=$$SELENT^IBTRH5D(.AIDATA,H1,H2,L1,L2,MAX,1,SECT)
+54 IF XX?1"D".N
Begin DoDot:1
+55 SET (XX,ENTNUM)=$PIECE(XX,"D",2)
+56 SET XX=$PIECE(AIDATA(XX),"^",1)
+57 DO DELSAPI(IBTRIEN,SIEN,XX)
+58 WRITE !,"Entry #",ENTNUM," has been deleted."
End DoDot:1
QUIT -3
+59 IF XX<0
QUIT XX
+60 IF XX=0
Begin DoDot:1
+61 ; Get the .01 value
SET RTYPE=$$RTYPE(IBTRIEN,SIEN)
+62 ; None entered
IF RTYPE=""
SET XX=-1
QUIT
+63 SET XX=RTYPE
+64 SET IBNEW=1
+65 SET FDA(356.22166,"+1,"_SIEN_","_IBTRIEN_",",.01)=RTYPE
+66 ; File the new line
DO UPDATE^DIE("","FDA","RETIEN")
End DoDot:1
QUIT $SELECT($ORDER(RETIEN(0)):RETIEN($ORDER(RETIEN(0))),1:XX)
+67 QUIT $PIECE(AIDATA(XX),"^",1)
+68 ;
DELSAPI(IBTRIEN,SIEN,IEN) ; Checks to see if the user entered 'NEW' to create a new
+1 ; Additional Patient Information Line and didn't enter any data for it or selected
+2 ; a line to be deleted. If so, the empty or selected Additional Patient Information
+3 ; line is deleted
+4 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+5 ; SIEN - IEN of the Service Line being edited
+6 ; IEN - Optional, IEN of the multiple to be deleted if passed
+7 ; defaults to ""
+8 ; Output: Empty or selected Additional Patient Information line is deleted (Potentially)
+9 NEW APIIEN,DA,DIK,X,XX,Y
+10 if '$DATA(IEN)
SET IEN=""
+11 IF IEN'=""
Begin DoDot:1
+12 SET DA(2)=IBTRIEN
SET DA(1)=SIEN
SET DA=IEN
+13 SET DIK="^IBT(356.22,DA(2),16,DA(1),6,"
+14 ; Delete the multiple
DO ^DIK
End DoDot:1
QUIT
+15 ;
+16 ; Last Multiple IEN
SET APIIEN=+$PIECE($GET(^IBT(356.22,IBTRIEN,16,SIEN,11,0)),"^",3)
+17 if 'APIIEN
QUIT
+18 SET XX=$GET(^IBT(356.22,IBTRIEN,16,SIEN,6,APIIEN,0))
+19 ; Remove .01 field
SET $PIECE(XX,"^",1)=""
+20 ; 0 node data exists
if $TRANSLATE(XX,"^","")'=""
QUIT
+21 SET DA(2)=IBTRIEN
SET DA(1)=SIEN
SET DA=APIIEN
+22 SET DIK="^IBT(356.22,DA(2),16,DA(1),6,"
+23 ; Delete the multiple
DO ^DIK
+24 QUIT
+25 ;
RTYPE(IBTRIEN,SIEN) ; Prompts the user to enter the .01 (Report Type) field of the
+1 ; Additional Patient Information 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 Report Type or "" of not entered
+5 NEW DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+6 SET DA(2)=IBTRIEN
SET DA(1)=SIEN
+7 SET DIR(0)="356.22166,.01"
SET DIR("A")=" Report Type"
+8 DO ^DIR
+9 if $DATA(DIRUT)
QUIT ""
+10 QUIT $PIECE(Y,"^",1)
+11 ;
SELSTI(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 Tooth
+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 ; 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,TDATA,IEN,H1,H2,IEN,IENS,L1,L2,MAX,RETIEN,SECT,TIDATA,TTYPE,X,XX,Y,YY
+11 SET IBNEW=0
SET SECT="Tooth Information"
+12 ;
+13 ; First check for an empty Additional Patient Information Line to delete
+14 DO DELSTI(IBTRIEN,SIEN)
+15 ;
+16 ; Next create an array of all current Service Line Tooth Information Lines
+17 ; Total # of multiples
SET XX=+$PIECE($GET(^IBT(356.22,IBTRIEN,16,SIEN,4,0)),"^",4)
+18 SET MAX=$SELECT(XX<32:"",1:"Tooth Information Lines")
+19 SET IEN=0
SET CNT=0
+20 FOR
Begin DoDot:1
+21 SET IEN=$ORDER(^IBT(356.22,IBTRIEN,16,SIEN,4,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 ; Tooth Code (External)
SET YY=$$GET1^DIQ(356.22164,IENS,.01,"I")
+27 ; Tooth Code
SET YY=$$GET1^DIQ(356.022,YY_",",.01)
+28 SET XX=XX_$$LJ^XLFSTR(YY,7)
+29 ; Tooth Surface #1
SET YY=$$GET1^DIQ(356.22164,IENS,.02)
+30 SET XX=XX_$$LJ^XLFSTR(YY,12)
+31 ; Tooth Surface #2
SET YY=$$GET1^DIQ(356.22164,IENS,.03)
+32 SET XX=XX_$$LJ^XLFSTR(YY,12)
+33 ; Tooth Surface #3
SET YY=$$GET1^DIQ(356.22164,IENS,.04)
+34 SET XX=XX_$$LJ^XLFSTR(YY,12)
+35 ; Tooth Surface #4
SET YY=$$GET1^DIQ(356.22164,IENS,.05)
+36 SET XX=XX_$$LJ^XLFSTR(YY,12)
+37 SET TIDATA(CNT)=IEN_"^"_XX
End DoDot:1
if +IEN=0
QUIT
+38 ;
+39 IF 'CNT
Begin DoDot:1
+40 WRITE !!," No Additional Patient Information is currently on file.",!
+41 SET XX=$$ASKNEW^IBTRH5D(" Add Tooth Information")
+42 if XX<0
QUIT
+43 ; Get the .01 value
SET TTYPE=$$TTYPE(IBTRIEN,SIEN)
+44 ; None entered
IF TTYPE=""
SET XX=-1
QUIT
+45 SET IBNEW=1
SET XX=TTYPE
+46 SET FDA(356.22164,"+1,"_SIEN_","_IBTRIEN_",",.01)=TTYPE
+47 ; File the new line
DO UPDATE^DIE("","FDA","RETIEN")
End DoDot:1
QUIT $SELECT($ORDER(RETIEN(0)):RETIEN($ORDER(RETIEN(0))),1:XX)
+48 ;
+49 ; Next display all of the current Tooth Information lines and let the user select one
+50 SET H1=" # Tooth Surface #1 Surface #2 Surface #3 Surface #4"
+51 SET H2=" -- ----- ---------- ---------- ---------- ----------"
+52 SET L1=" The following Tooth Information Lines are currently on file."
+53 SET L2=" Enter the # of a Line to edit, 'NEW' to add one or press Return to skip."
+54 SET XX=$$SELENT^IBTRH5D(.TIDATA,H1,H2,L1,L2,MAX,1,SECT)
+55 IF XX?1"D".N
Begin DoDot:1
+56 SET (XX,ENTNUM)=$PIECE(XX,"D",2)
+57 SET XX=$PIECE(TIDATA(XX),"^",1)
+58 DO DELSTI(IBTRIEN,SIEN,XX)
+59 WRITE !,"Entry #",ENTNUM," has been deleted."
End DoDot:1
QUIT -3
+60 IF XX<0
QUIT XX
+61 IF XX=0
Begin DoDot:1
+62 ; Get the .01 value
SET TTYPE=$$TTYPE(IBTRIEN,SIEN)
+63 ; None entered
IF TTYPE=""
SET XX=-1
QUIT
+64 SET IBNEW=1
+65 SET XX=TTYPE
+66 SET FDA(356.22164,"+1,"_SIEN_","_IBTRIEN_",",.01)=TTYPE
+67 ; File the new line
DO UPDATE^DIE("","FDA","RETIEN")
End DoDot:1
QUIT $SELECT($ORDER(RETIEN(0)):RETIEN($ORDER(RETIEN(0))),1:XX)
+68 QUIT $PIECE(TIDATA(XX),"^",1)
+69 ;
DELSTI(IBTRIEN,SIEN,IEN) ; Checks to see if the user entered 'NEW' to create a new
+1 ; Tooth Information Line and didn't enter any data for it OR selected a line
+2 ; to be deleted. If so, the Additional Tooth Information line with no data
+3 ; (or selected) is deleted
+4 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+5 ; SIEN - IEN of the Service Line being edited
+6 ; Output: Empty (or selected) Tooth Information line is deleted (Potentially)
+7 NEW DA,DIK,TIIEN,X,XX,Y
+8 if '$DATA(IEN)
SET IEN=""
+9 IF IEN'=""
Begin DoDot:1
+10 SET DA(2)=IBTRIEN
SET DA(1)=SIEN
SET DA=IEN
+11 SET DIK="^IBT(356.22,DA(2),16,DA(1),4,"
+12 ; Delete the multiple
DO ^DIK
End DoDot:1
QUIT
+13 ;
+14 ; Last Multiple IEN
SET TIIEN=+$PIECE($GET(^IBT(356.22,IBTRIEN,16,SIEN,4,0)),"^",3)
+15 if 'TIIEN
QUIT
+16 SET XX=$GET(^IBT(356.22,IBTRIEN,16,SIEN,4,TIIEN,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=TIIEN
+20 SET DIK="^IBT(356.22,DA(2),16,DA(1),4,"
+21 ; Delete the multiple
DO ^DIK
+22 QUIT
+23 ;
TTYPE(IBTRIEN,SIEN) ; Prompts the user to enter the .01 (Tooth) field of the
+1 ; Tooth Information 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 Tooth Type or "" of not entered
+5 NEW DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+6 SET DA(2)=IBTRIEN
SET DA(1)=SIEN
+7 SET DIR(0)="356.22164,.01"
SET DIR("A")=" Tooth Code"
+8 DO ^DIR
+9 if $DATA(DIRUT)
QUIT ""
+10 QUIT $PIECE(Y,"^",1)
+11 ;
