IBTRH5D ;ALB/FA - HCSR Create 278 Request ;12-AUG-2014
;;2.0;INTEGRATED BILLING;**517,592**;21-MAR-94;Build 58
;;Per VA Directive 6402, this routine should not be modified.
;;
; Contains Functions used in creating a 278 request from a
; selected entry in the HCSR Response worklist
;
; -------------------------- Entry Points --------------------------------
; SELAPI - Allows the user to see a quick view of the currently entered
; Additional Patient Information lines and either pick one to
; edit, enter a new one or skip.
; SELDX - Allows the user to see a quick view of the currently entered
; Diagnoses and either pick one to edit, enter a new one or
; skip.
; SELPD - Allows the user to see a quick view of the currently entered
; Patient Event Provider Data Lines and either pick one to
; edit, enter a new one or skip.
;-----------------------------------------------------------------------------
;
SELAPI(IBTRIEN) ;EP
; Called from within Input template IB CREATE 278 REQUEST
; Provides the user with a quick view of currently entered 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
; Returns: Value of the .01 field of the multiple to edit
; "" if creating a new multiple, -2 to exit template
; IBNEW - 1 if creating a new entry
N AIDATA,CNT,ENTNUM,FDA,IEN,H1,H2,L1,L2,MAX,RETIEN,RTYPE,SECT,X,XX,Y,YY
S IBNEW=0,SECT="Additional Patient Information"
;
; First check for an empty Additional Patient Information Line to delete
D DELAPI(IBTRIEN)
;
; Next create an array of all current Additional Patient Information lines to
; display
S XX=+$P($G(^IBT(356.22,IBTRIEN,11,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,11,IEN))
. Q:+IEN=0
. S CNT=CNT+1
. S XX=$$LJ^XLFSTR(CNT,4) ; Selection #
. S YY=$$GET1^DIQ(356.2211,IEN_","_DA_",",.01) ; Report Type Desc
. S YY=$E(YY,1,28)_" "
. S XX=XX_$$LJ^XLFSTR(YY,30)
. S YY=$$GET1^DIQ(356.2211,IEN_","_DA_",",.02) ; Delivery Method
. S YY=$E(YY,1,20)_" "
. S XX=XX_$$LJ^XLFSTR(YY,23)
. S YY=$$GET1^DIQ(356.2211,IEN_","_DA_",",.03) ; Attachment #
. 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("Add Additional Patient Information","NO")
. Q:XX<0
. S RTYPE=$$RTYPE(IBTRIEN) ; Get the .01 value
. I RTYPE="" S XX=-1 Q ; None entered
. S IBNEW=1,XX=RTYPE
. S FDA(356.2211,"+1,"_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(.AIDATA,H1,H2,L1,L2,MAX,"",SECT)
I XX?1"D".N D Q -3
. S (XX,ENTNUM)=$P(XX,"D",2)
. S XX=$P(AIDATA(XX),U)
. D DELAPI(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 RTYPE=$$RTYPE(IBTRIEN) ; Get the .01 value
. I RTYPE="" S XX=-1 Q ; None entered
. S IBNEW=1
. S XX=RTYPE
. S FDA(356.2211,"+1,"_IBTRIEN_",",.01)=RTYPE
. D UPDATE^DIE("","FDA","RETIEN") ; File the new line
Q $P(AIDATA(XX),"^",1)
;
DELAPI(IBTRIEN,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. Also
; checks to see if user selected to delete a specified line. If so, the
; Additional Patient 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 Additional Patient Information line is deleted (Potentially)
N APIIEN,DA,DIK,X,XX,Y
S:'$D(IEN) IEN=""
I IEN'="" D Q
. S DA(1)=IBTRIEN,DA=IEN
. S DIK="^IBT(356.22,DA(1),11,"
. D ^DIK ; Delete the multiple
;
S APIIEN=+$P($G(^IBT(356.22,IBTRIEN,11,0)),"^",3) ; Last Multiple IEN
Q:'APIIEN
S XX=$G(^IBT(356.22,IBTRIEN,11,APIIEN,0))
S $P(XX,"^",1)="" ; Remove .01 field
Q:$TR(XX,"^","")'="" ; 0 node data exists
S DA(1)=IBTRIEN,DA=APIIEN
S DIK="^IBT(356.22,DA(1),11,"
D ^DIK ; Delete the multiple
Q
;
RTYPE(IBTRIEN) ; 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
; Returns: IEN of the selected Report Type or "" of not entered
N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DA(1)=IBTRIEN
S DIR(0)="356.2211,.01",DIR("A")=" Report Type"
D ^DIR
Q:$D(DIRUT) ""
Q $P(Y,"^",1)
;
SELPD(IBTRIEN) ;EP
; Called from within Input template IB CREATE 278 REQUEST
; Provides the user with a quick view of currently entered 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
; IBTRBRF - 1 if this display is being used from the brief template
; 0 or undefined otherwise
; 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,PDDATA,PTYPE,RETIEN,SECT,X,XX,Y,YY
S IBNEW=0,SECT="Provider Data Information"
;
; First check for an empty Provider Data Line to delete
D DELPD(IBTRIEN)
;
; Next create an array of all current Provider Data Information lines
S XX=+$P($G(^IBT(356.22,IBTRIEN,13,0)),"^",4) ; # of Multiples
S MAX=$S(XX<14:"",1:"Provider Data Lines")
S IEN=0,CNT=0
F D Q:+IEN=0
. S IEN=$O(^IBT(356.22,IBTRIEN,13,IEN))
. Q:+IEN=0
. S CNT=CNT+1
. S XX=$$LJ^XLFSTR(CNT,4) ; Selection #
. S YY=$$GET1^DIQ(356.2213,IEN_","_DA_",",.01) ; Prov Type Desc
. S YY=$E(YY,1,30)_" "
. S XX=XX_$$LJ^XLFSTR(YY,32)
. ;
. ; IBTRBRF is defined in IB CREATE 278 REQUEST SHORT input template
. I $G(IBTRBRF)'=1 D
. . S YY=$$GET1^DIQ(356.2213,IEN_","_DA_",",.02) ; Person/Non-Person
. . S XX=XX_$$LJ^XLFSTR(YY,12)
. S YY=$$GET1^DIQ(356.2213,IEN_","_DA_",",.03)
. S XX=XX_$$LJ^XLFSTR(YY,"28T")
. S PDDATA(CNT)=IEN_"^"_XX
;
I 'CNT D Q $S($O(RETIEN(0)):RETIEN($O(RETIEN(0))),1:XX)
.I $G(IBTRBRF)'=1 D
..W !!,"No Provider Data Information is currently on file.",!
..S XX=$$ASKNEW("Add Provider Data Information")
..Q
.I $G(IBTRBRF)=1 S XX=0
.Q:XX<0
.S PTYPE=$$PTYPE(IBTRIEN) ; Get the .01 value
.I PTYPE="" S XX=-1 Q ; None entered
.S IBNEW=1,XX=PTYPE
.S FDA(356.2213,"+1,"_IBTRIEN_",",.01)=PTYPE
.D UPDATE^DIE("","FDA","RETIEN") ; File the new line
.Q
;
; Next display all of the current Provider Data lines
S H1="# Provider Type "
I $G(IBTRBRF)'=1 S H1=H1_" Per/Non"
S H1=H1_" Provider"
S H2="-- ------------------------------"
I $G(IBTRBRF)'=1 S H2=H2_" ----------"
S H2=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(.PDDATA,H1,H2,L1,L2,MAX,"",SECT)
I XX?1"D".N D Q -3
. S (XX,ENTNUM)=$P(XX,"D",2)
. S XX=$P(PDDATA(XX),U)
. D DELPD(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 PTYPE=$$PTYPE(IBTRIEN) ; Get the .01 value
. I PTYPE="" S XX=-1 Q ; None entered
. S XX=PTYPE
. S IBNEW=1
. S FDA(356.2213,"+1,"_IBTRIEN_",",.01)=PTYPE
. D UPDATE^DIE("","FDA","RETIEN") ; File the new line
Q $P(PDDATA(XX),"^",1)
;
DELPD(IBTRIEN,IEN) ; Checks to see if the user entered 'NEW' to create a new
; Provider Data Line and didn't enter any data for it or selected a line to
; be deleted. If so, the empty or selected Provider Data line 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 Provider Data line is deleted (Potentially)
N PDIEN,DA,DIK,X,XX,Y
S:'$D(IEN) IEN=""
I IEN'="" D Q
. S DA(1)=IBTRIEN,DA=IEN
. S DIK="^IBT(356.22,DA(1),13,"
. D ^DIK ; Delete the multiple
;
S PDIEN=+$P($G(^IBT(356.22,IBTRIEN,13,0)),"^",3) ; Last Multiple IEN
Q:'PDIEN
S XX=$G(^IBT(356.22,IBTRIEN,13,PDIEN,0))
S $P(XX,"^",1)="" ; Remove .01 field
Q:$TR(XX,"^","")'="" ; 0 node data exists
S DA(1)=IBTRIEN,DA=PDIEN
S DIK="^IBT(356.22,DA(1),13,"
D ^DIK ; Delete the multiple
Q
;
PTYPE(IBTRIEN) ; 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
; 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.2213,.01",DIR("A")=" Provider Type"
D ^DIR
Q:$D(DIRUT) ""
Q $P(Y,"^",1)
;
SELDX(IBTRIEN) ;EP
; Called from within Input template IB CREATE 278 REQUEST
; Provides the user with a quick view of currently entered Diagnoses and
; allows them to select one to edit or enter a new diagnosis.
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; IBTRBRF - 1 if this display is being used from the brief template
; 0 or undefined other otherwise
; Returns: Value of the .01 field of the multiple to edit
; "" if creating a new multiple, -2 to exit template
; -3 if a if a line was deleted
; IBNEW=1 when creating a new entry
N CNT,DXDATA,DXTYPE,ENTNUM,FDA,IEN,H1,H2,L1,L2,MAX,RETIEN,SECT,X,XX,Y,YY
S IBNEW=0,SECT="Diagnosis Information"
;
; First check for an empty Diagnosis Line to delete
D DELDX(IBTRIEN)
;
; Next create an array of all current Diagnoses lines
S XX=+$P($G(^IBT(356.22,IBTRIEN,3,0)),"^",4) ; Total # of Dx Lines
S MAX=$S(XX<12:"",1:"Diagnosis Lines")
S IEN=0,CNT=0
F D Q:+IEN=0
. S IEN=$O(^IBT(356.22,IBTRIEN,3,IEN))
. Q:+IEN=0
. S CNT=CNT+1
. S XX=$$LJ^XLFSTR(CNT,4) ; Selection #
. S YY=$$GET1^DIQ(356.223,IEN_","_DA_",",.01,"I") ; Diagnosis Type
. S YY=$$GET1^DIQ(356.006,YY_",",.01)
. S XX=XX_$$LJ^XLFSTR(YY,7)
. S YY=$$GET1^DIQ(356.223,IEN_","_DA_",",.02) ; Diagnosis
. S XX=XX_$$LJ^XLFSTR(YY,11)
. I $G(IBTRBRF)'=1 D
. . S YY=$$GET1^DIQ(356.223,IEN_","_DA_",",.03) ; Date Known
. . S XX=XX_$$LJ^XLFSTR(YY,14)
. S DXDATA(CNT)=IEN_"^"_XX
;
; Creating 1st Diagnosis Line?
I 'CNT D Q $S($O(RETIEN(0)):RETIEN($O(RETIEN(0))),1:XX)
.I $G(IBTRBRF)'=1 D
..W !!,"No Diagnosis Information is currently on file.",!
..S XX=$$ASKNEW("Add a new Diagnosis")
..Q
.I $G(IBTRBRF)=1 S XX=0
.Q:XX<0
.S DXTYPE=$$DXTYPE(IBTRIEN) ; Get the .01 value
.I DXTYPE="" S XX=-1 Q ; None entered
.S IBNEW=1,XX=DXTYPE
.S FDA(356.223,"+1,"_IBTRIEN_",",.01)=DXTYPE
.D UPDATE^DIE("","FDA","RETIEN") ; File the new line
.Q
;
; Next display all of the current Diagnoses and let the user select one
S H1="# Type Diagnosis"
I $G(IBTRBRF)'=1 S H1=H1_" Date DX Known"
S H2="-- ----- ---------"
I $G(IBTRBRF)'=1 S H2=H2_" -------------"
S L1="The following Diagnoses are currently on file."
S L2="Enter the # of a Diagnosis to edit, 'NEW' to add one or press Return to skip."
S XX=$$SELENT(.DXDATA,H1,H2,L1,L2,MAX,"",SECT)
I XX?1"D".N D Q -3
. S (XX,ENTNUM)=$P(XX,"D",2)
. S XX=$P(DXDATA(XX),U)
. D DELDX(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 DXTYPE=$$DXTYPE(IBTRIEN) ; Get the .01 value
. I DXTYPE="" S XX=-1 Q ; None entered
. S XX=DXTYPE
. S IBNEW=1
. S FDA(356.223,"+1,"_IBTRIEN_",",.01)=DXTYPE
. D UPDATE^DIE("","FDA","RETIEN") ; File the new line
Q $P(DXDATA(XX),"^",1)
;
DXTYPE(IBTRIEN) ; Prompts the user to enter the .01 (Diagnosis Type) field of
; the diagnosis multiple
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; Returns: IEN of the selected Diagnosis Type or "" of not entered
N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DA(1)=IBTRIEN,DA=$P($G(^IBT(356.22,IBTRIEN,3,0)),"^",3)+1
S DIR(0)="356.223,.01",DIR("A")=" Diagnosis Qualifier"
D ^DIR
Q:$D(DIRUT) ""
Q $P(Y,"^",1)
;
DELDX(IBTRIEN,IEN) ; Checks to see if the user entered 'NEW' to create a new
; Diagnosis Line and didn't enter any data for it or selected a multiple to
; to be deleted. If so, the empty or selected multiple 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 Diagnosis line is deleted (Potentially)
N DA,DIK,DXIEN,X,XX,Y
S:'$D(IEN) IEN=""
I IEN'="" D Q
. S DA(1)=IBTRIEN,DA=IEN
. S DIK="^IBT(356.22,DA(1),3,"
. D ^DIK ; Delete the multiple
;
S DXIEN=+$P($G(^IBT(356.22,IBTRIEN,3,0)),"^",3) ; Last Multiple IEN
Q:'DXIEN
S XX=$G(^IBT(356.22,IBTRIEN,3,DXIEN,0))
S $P(XX,"^",1)="" ; Remove .01 field
Q:$TR(XX,"^","")'="" ; 0 node data exists
S DA(1)=IBTRIEN,DA=DXIEN
S DIK="^IBT(356.22,DA(1),3,"
D ^DIK ; Delete the multiple
Q
;
ASKNEW(PROMPT,DEFAULT) ;EP
; Ask if user wants to create a new entry
; Input: PROMPT - Yes/No question to ask the user
; DEFALT - Default Answer
; Optional, if not passed, set to 'YES'
; Returns: 0 - User wants to add a new Entry
; -1 - User doesn't want to add a new entry
; -2 - User wants to exit template
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,XX,Y
S:'$D(DEFAULT) DEFAULT="YES"
S XX=$P(PROMPT,"Add ",2)
S DIR("?")="Select NO to skip this section. Select YES to enter "_XX_"."
S DIR(0)="Y",DIR("A")=PROMPT,DIR("B")=DEFAULT
A1 ;
D ^DIR
I Y?1"^"1.E D JUMPERR^IBTRH5H G A1
Q:$D(DUOUT) -2 ; User Pressed ^
Q:$D(DTOUT) -1 ; User timed out
I Y=0 Q -1
Q 1
;
SELENT(ARRAY,H1,H2,L1,L2,MAX,INDENT,SECT) ; Select an entry to add/edit from a list
; Input: ARRAY() - Array of multiple lines to be displayed
; H1 - 1st line of Header Information
; H2 - 2nd line of Header Information
; L1 - 1st line of DIR display
; L2 - Selection line text
; MAX - Multiple Description
; If passed, entering a new line is not allowed
; Optional, defaults to "" if not passed
; INDENT - 1 to indent 2 spaces
; Optional, defaults to 0
; SECT - Section Header
; Returns: # - User wants to edit Entry #
; 0 - User wants to Add a new Entry
; -1 - User wants to skip this section
; -2 - User wants to exit template
N DEL,DIR,DIROUT,DIRUT,DOK,DTOUT,DUOUT,IX,LN,X,XX,Y,YY
S:'$D(MAX) MAX=""
S:'$D(INDENT) INDENT=0
S:'$D(SECT) SECT=""
S DIR(0)="FO",LN=0
S LN=LN+1,DIR("A",LN)=L1
S LN=LN+1,DIR("A",LN)=" "
S LN=LN+1,DIR("A",LN)=H1
S LN=LN+1,DIR("A",LN)=H2
S IX=""
F D Q:IX=""
. S IX=$O(ARRAY(IX))
. Q:IX=""
. S LN=LN+1,DIR("A",LN)=$P(ARRAY(IX),"^",2)
S LN=LN+1,DIR("A",LN)=" "
S LN=LN+1,DIR("A",LN)=L2
S DIR("A")=$S(INDENT:" ",1:"")_"Selection #"
W !!
SELE1 ;
;S XX="Select NO to skip this section. Select YES to enter "_SECT_"."
S XX="To delete an entry from the list, select D followed by the "
S XX=XX_"number of the entry you wish to delete."
S DIR("?")=XX
D ^DIR
S DOK=1
S Y=$$UP^XLFSTR(Y) ; Convert to Upper
I Y?1"D".N D Q:DOK Y
. S XX=$P(Y,"D",2)
. I XX>0,XX'>CNT,XX?.N Q ; Selected Entry to delete
. S DOK=0
. D SELERR(INDENT)
G:'DOK SELE1
I Y?1"^"1.E D JUMPERR^IBTRH5H G SELE1
I $D(DUOUT) Q -2 ; User pressed ^
I $D(DTOUT) Q -1 ; User timed out
I Y="" Q -1 ; User pressed return
S XX=$$UP^XLFSTR(Y)
S YY=$S((XX="NEW")!(XX="N")!(XX="NE"):1,1:0) ; User wants to enter a new one
I MAX'="",YY D G SELE1
. W *7,!!,$S(INDENT:" ",1:"")
. W "The maximum Number of "_MAX_" have already been entered.",!
. ;JWS;IB*2.0*592
. I +CNT>21 R !!,"Press <ENTER> to continue",X:30
Q:YY 0 ; Creating a new one
I XX>0,XX'>CNT,XX?.N Q XX ; Selected Entry
D SELERR(INDENT)
G SELE1
;
SELERR(INDENT) ; Multiple Selection error
; Input: INDENT - 1 to indent error message display
W !!,*7,$S(INDENT:" ",1:"")
W "Enter a number from 1-",CNT,". Enter NEW to enter a new entry."
W !,$S(INDENT:" ",1:"")
W "To delete an entry from the list, select D followed by the "
W !,$S(INDENT:" ",1:"")
W "number of the entry you wish to remove. Press return to skip selection."
W !!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRH5D 18611 printed Dec 13, 2024@02:28:10 Page 2
IBTRH5D ;ALB/FA - HCSR Create 278 Request ;12-AUG-2014
+1 ;;2.0;INTEGRATED BILLING;**517,592**;21-MAR-94;Build 58
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;
+4 ; Contains Functions used in creating a 278 request from a
+5 ; selected entry in the HCSR Response worklist
+6 ;
+7 ; -------------------------- Entry Points --------------------------------
+8 ; SELAPI - Allows the user to see a quick view of the currently entered
+9 ; Additional Patient Information lines and either pick one to
+10 ; edit, enter a new one or skip.
+11 ; SELDX - Allows the user to see a quick view of the currently entered
+12 ; Diagnoses and either pick one to edit, enter a new one or
+13 ; skip.
+14 ; SELPD - Allows the user to see a quick view of the currently entered
+15 ; Patient Event Provider Data Lines and either pick one to
+16 ; edit, enter a new one or skip.
+17 ;-----------------------------------------------------------------------------
+18 ;
SELAPI(IBTRIEN) ;EP
+1 ; Called from within Input template IB CREATE 278 REQUEST
+2 ; Provides the user with a quick view of currently entered Additional Patient
+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 if creating a new entry
+9 NEW AIDATA,CNT,ENTNUM,FDA,IEN,H1,H2,L1,L2,MAX,RETIEN,RTYPE,SECT,X,XX,Y,YY
+10 SET IBNEW=0
SET SECT="Additional Patient Information"
+11 ;
+12 ; First check for an empty Additional Patient Information Line to delete
+13 DO DELAPI(IBTRIEN)
+14 ;
+15 ; Next create an array of all current Additional Patient Information lines to
+16 ; display
+17 ; Total # of API Lines
SET XX=+$PIECE($GET(^IBT(356.22,IBTRIEN,11,0)),"^",4)
+18 SET MAX=$SELECT(XX<10:"",1:"Additional Patient Information Lines")
+19 SET IEN=0
SET CNT=0
+20 FOR
Begin DoDot:1
+21 SET IEN=$ORDER(^IBT(356.22,IBTRIEN,11,IEN))
+22 if +IEN=0
QUIT
+23 SET CNT=CNT+1
+24 ; Selection #
SET XX=$$LJ^XLFSTR(CNT,4)
+25 ; Report Type Desc
SET YY=$$GET1^DIQ(356.2211,IEN_","_DA_",",.01)
+26 SET YY=$EXTRACT(YY,1,28)_" "
+27 SET XX=XX_$$LJ^XLFSTR(YY,30)
+28 ; Delivery Method
SET YY=$$GET1^DIQ(356.2211,IEN_","_DA_",",.02)
+29 SET YY=$EXTRACT(YY,1,20)_" "
+30 SET XX=XX_$$LJ^XLFSTR(YY,23)
+31 ; Attachment #
SET YY=$$GET1^DIQ(356.2211,IEN_","_DA_",",.03)
+32 SET YY=$EXTRACT(YY,1,22)
+33 SET XX=XX_$$LJ^XLFSTR(YY,22)
+34 SET AIDATA(CNT)=IEN_"^"_XX
End DoDot:1
if +IEN=0
QUIT
+35 ;
+36 IF 'CNT
Begin DoDot:1
+37 WRITE !!,"No Additional Patient Information is currently on file.",!
+38 SET XX=$$ASKNEW("Add Additional Patient Information","NO")
+39 if XX<0
QUIT
+40 ; Get the .01 value
SET RTYPE=$$RTYPE(IBTRIEN)
+41 ; None entered
IF RTYPE=""
SET XX=-1
QUIT
+42 SET IBNEW=1
SET XX=RTYPE
+43 SET FDA(356.2211,"+1,"_IBTRIEN_",",.01)=RTYPE
+44 ; File the new line
DO UPDATE^DIE("","FDA","RETIEN")
End DoDot:1
QUIT $SELECT($ORDER(RETIEN(0)):RETIEN($ORDER(RETIEN(0))),1:XX)
+45 ;
+46 ; Next display all of the current Additional Patient Information
+47 SET H1="# Report Type Delivery Method Attachment Control #"
+48 SET H2="-- ---------------------------- --------------------- ----------------------"
+49 SET L1="The following Additional Patient Information is currently on file."
+50 SET L2="Enter the # of an entry to edit, 'NEW' to add one or press Return to skip."
+51 SET XX=$$SELENT(.AIDATA,H1,H2,L1,L2,MAX,"",SECT)
+52 IF XX?1"D".N
Begin DoDot:1
+53 SET (XX,ENTNUM)=$PIECE(XX,"D",2)
+54 SET XX=$PIECE(AIDATA(XX),U)
+55 DO DELAPI(IBTRIEN,XX)
+56 WRITE !,"Entry #",ENTNUM," has been deleted."
End DoDot:1
QUIT -3
+57 IF XX<0
QUIT XX
+58 IF XX=0
Begin DoDot:1
+59 ; Get the .01 value
SET RTYPE=$$RTYPE(IBTRIEN)
+60 ; None entered
IF RTYPE=""
SET XX=-1
QUIT
+61 SET IBNEW=1
+62 SET XX=RTYPE
+63 SET FDA(356.2211,"+1,"_IBTRIEN_",",.01)=RTYPE
+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(AIDATA(XX),"^",1)
+66 ;
DELAPI(IBTRIEN,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. Also
+2 ; checks to see if user selected to delete a specified line. If so, the
+3 ; Additional Patient Information line with 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 Additional Patient Information line is deleted (Potentially)
+8 NEW APIIEN,DA,DIK,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),11,"
+13 ; Delete the multiple
DO ^DIK
End DoDot:1
QUIT
+14 ;
+15 ; Last Multiple IEN
SET APIIEN=+$PIECE($GET(^IBT(356.22,IBTRIEN,11,0)),"^",3)
+16 if 'APIIEN
QUIT
+17 SET XX=$GET(^IBT(356.22,IBTRIEN,11,APIIEN,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=APIIEN
+21 SET DIK="^IBT(356.22,DA(1),11,"
+22 ; Delete the multiple
DO ^DIK
+23 QUIT
+24 ;
RTYPE(IBTRIEN) ; 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 ; Returns: IEN of the selected Report Type or "" of not entered
+4 NEW DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+5 SET DA(1)=IBTRIEN
+6 SET DIR(0)="356.2211,.01"
SET DIR("A")=" Report Type"
+7 DO ^DIR
+8 if $DATA(DIRUT)
QUIT ""
+9 QUIT $PIECE(Y,"^",1)
+10 ;
SELPD(IBTRIEN) ;EP
+1 ; Called from within Input template IB CREATE 278 REQUEST
+2 ; Provides the user with a quick view of currently entered Provider Data
+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 ; IBTRBRF - 1 if this display is being used from the brief template
+6 ; 0 or undefined otherwise
+7 ; Returns: Value of the .01 field of the multiple to edit
+8 ; "" if creating a new multiple, -2 to exit template
+9 ; IBNEW=1 when creating a new entry
+10 NEW CNT,ENTNUM,FDA,IEN,H1,H2,L1,L2,MAX,PDDATA,PTYPE,RETIEN,SECT,X,XX,Y,YY
+11 SET IBNEW=0
SET SECT="Provider Data Information"
+12 ;
+13 ; First check for an empty Provider Data Line to delete
+14 DO DELPD(IBTRIEN)
+15 ;
+16 ; Next create an array of all current Provider Data Information lines
+17 ; # of Multiples
SET XX=+$PIECE($GET(^IBT(356.22,IBTRIEN,13,0)),"^",4)
+18 SET MAX=$SELECT(XX<14:"",1:"Provider Data Lines")
+19 SET IEN=0
SET CNT=0
+20 FOR
Begin DoDot:1
+21 SET IEN=$ORDER(^IBT(356.22,IBTRIEN,13,IEN))
+22 if +IEN=0
QUIT
+23 SET CNT=CNT+1
+24 ; Selection #
SET XX=$$LJ^XLFSTR(CNT,4)
+25 ; Prov Type Desc
SET YY=$$GET1^DIQ(356.2213,IEN_","_DA_",",.01)
+26 SET YY=$EXTRACT(YY,1,30)_" "
+27 SET XX=XX_$$LJ^XLFSTR(YY,32)
+28 ;
+29 ; IBTRBRF is defined in IB CREATE 278 REQUEST SHORT input template
+30 IF $GET(IBTRBRF)'=1
Begin DoDot:2
+31 ; Person/Non-Person
SET YY=$$GET1^DIQ(356.2213,IEN_","_DA_",",.02)
+32 SET XX=XX_$$LJ^XLFSTR(YY,12)
End DoDot:2
+33 SET YY=$$GET1^DIQ(356.2213,IEN_","_DA_",",.03)
+34 SET XX=XX_$$LJ^XLFSTR(YY,"28T")
+35 SET PDDATA(CNT)=IEN_"^"_XX
End DoDot:1
if +IEN=0
QUIT
+36 ;
+37 IF 'CNT
Begin DoDot:1
+38 IF $GET(IBTRBRF)'=1
Begin DoDot:2
+39 WRITE !!,"No Provider Data Information is currently on file.",!
+40 SET XX=$$ASKNEW("Add Provider Data Information")
+41 QUIT
End DoDot:2
+42 IF $GET(IBTRBRF)=1
SET XX=0
+43 if XX<0
QUIT
+44 ; Get the .01 value
SET PTYPE=$$PTYPE(IBTRIEN)
+45 ; None entered
IF PTYPE=""
SET XX=-1
QUIT
+46 SET IBNEW=1
SET XX=PTYPE
+47 SET FDA(356.2213,"+1,"_IBTRIEN_",",.01)=PTYPE
+48 ; File the new line
DO UPDATE^DIE("","FDA","RETIEN")
+49 QUIT
End DoDot:1
QUIT $SELECT($ORDER(RETIEN(0)):RETIEN($ORDER(RETIEN(0))),1:XX)
+50 ;
+51 ; Next display all of the current Provider Data lines
+52 SET H1="# Provider Type "
+53 IF $GET(IBTRBRF)'=1
SET H1=H1_" Per/Non"
+54 SET H1=H1_" Provider"
+55 SET H2="-- ------------------------------"
+56 IF $GET(IBTRBRF)'=1
SET H2=H2_" ----------"
+57 SET H2=H2_" ------------------------------"
+58 SET L1="The following Provider Data Information is currently on file."
+59 SET L2="Enter the # of an entry to edit, 'NEW' to add one or press Return to skip."
+60 SET XX=$$SELENT(.PDDATA,H1,H2,L1,L2,MAX,"",SECT)
+61 IF XX?1"D".N
Begin DoDot:1
+62 SET (XX,ENTNUM)=$PIECE(XX,"D",2)
+63 SET XX=$PIECE(PDDATA(XX),U)
+64 DO DELPD(IBTRIEN,XX)
+65 WRITE !,"Entry #",ENTNUM," has been deleted."
End DoDot:1
QUIT -3
+66 IF XX<0
QUIT XX
+67 IF XX=0
Begin DoDot:1
+68 ; Get the .01 value
SET PTYPE=$$PTYPE(IBTRIEN)
+69 ; None entered
IF PTYPE=""
SET XX=-1
QUIT
+70 SET XX=PTYPE
+71 SET IBNEW=1
+72 SET FDA(356.2213,"+1,"_IBTRIEN_",",.01)=PTYPE
+73 ; File the new line
DO UPDATE^DIE("","FDA","RETIEN")
End DoDot:1
QUIT $SELECT($ORDER(RETIEN(0)):RETIEN($ORDER(RETIEN(0))),1:XX)
+74 QUIT $PIECE(PDDATA(XX),"^",1)
+75 ;
DELPD(IBTRIEN,IEN) ; Checks to see if the user entered 'NEW' to create a new
+1 ; Provider Data Line and didn't enter any data for it or selected a line to
+2 ; be deleted. If so, the empty or selected Provider Data line 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 Provider Data line is deleted (Potentially)
+7 NEW PDIEN,DA,DIK,X,XX,Y
+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),13,"
+12 ; Delete the multiple
DO ^DIK
End DoDot:1
QUIT
+13 ;
+14 ; Last Multiple IEN
SET PDIEN=+$PIECE($GET(^IBT(356.22,IBTRIEN,13,0)),"^",3)
+15 if 'PDIEN
QUIT
+16 SET XX=$GET(^IBT(356.22,IBTRIEN,13,PDIEN,0))
+17 ; Remove .01 field
SET $PIECE(XX,"^",1)=""
+18 ; 0 node data exists
if $TRANSLATE(XX,"^","")'=""
QUIT
+19 SET DA(1)=IBTRIEN
SET DA=PDIEN
+20 SET DIK="^IBT(356.22,DA(1),13,"
+21 ; Delete the multiple
DO ^DIK
+22 QUIT
+23 ;
PTYPE(IBTRIEN) ; Prompts the user to enter the .01 (Provider Type) field of the
+1 ; Provider Data multiple
+2 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+3 ; Returns: IEN of the selected Provider Type or "" of not entered
+4 NEW DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+5 SET DA(1)=IBTRIEN
+6 SET DIR(0)="356.2213,.01"
SET DIR("A")=" Provider Type"
+7 DO ^DIR
+8 if $DATA(DIRUT)
QUIT ""
+9 QUIT $PIECE(Y,"^",1)
+10 ;
SELDX(IBTRIEN) ;EP
+1 ; Called from within Input template IB CREATE 278 REQUEST
+2 ; Provides the user with a quick view of currently entered Diagnoses and
+3 ; allows them to select one to edit or enter a new diagnosis.
+4 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+5 ; IBTRBRF - 1 if this display is being used from the brief template
+6 ; 0 or undefined other otherwise
+7 ; Returns: Value of the .01 field of the multiple to edit
+8 ; "" if creating a new multiple, -2 to exit template
+9 ; -3 if a if a line was deleted
+10 ; IBNEW=1 when creating a new entry
+11 NEW CNT,DXDATA,DXTYPE,ENTNUM,FDA,IEN,H1,H2,L1,L2,MAX,RETIEN,SECT,X,XX,Y,YY
+12 SET IBNEW=0
SET SECT="Diagnosis Information"
+13 ;
+14 ; First check for an empty Diagnosis Line to delete
+15 DO DELDX(IBTRIEN)
+16 ;
+17 ; Next create an array of all current Diagnoses lines
+18 ; Total # of Dx Lines
SET XX=+$PIECE($GET(^IBT(356.22,IBTRIEN,3,0)),"^",4)
+19 SET MAX=$SELECT(XX<12:"",1:"Diagnosis Lines")
+20 SET IEN=0
SET CNT=0
+21 FOR
Begin DoDot:1
+22 SET IEN=$ORDER(^IBT(356.22,IBTRIEN,3,IEN))
+23 if +IEN=0
QUIT
+24 SET CNT=CNT+1
+25 ; Selection #
SET XX=$$LJ^XLFSTR(CNT,4)
+26 ; Diagnosis Type
SET YY=$$GET1^DIQ(356.223,IEN_","_DA_",",.01,"I")
+27 SET YY=$$GET1^DIQ(356.006,YY_",",.01)
+28 SET XX=XX_$$LJ^XLFSTR(YY,7)
+29 ; Diagnosis
SET YY=$$GET1^DIQ(356.223,IEN_","_DA_",",.02)
+30 SET XX=XX_$$LJ^XLFSTR(YY,11)
+31 IF $GET(IBTRBRF)'=1
Begin DoDot:2
+32 ; Date Known
SET YY=$$GET1^DIQ(356.223,IEN_","_DA_",",.03)
+33 SET XX=XX_$$LJ^XLFSTR(YY,14)
End DoDot:2
+34 SET DXDATA(CNT)=IEN_"^"_XX
End DoDot:1
if +IEN=0
QUIT
+35 ;
+36 ; Creating 1st Diagnosis Line?
+37 IF 'CNT
Begin DoDot:1
+38 IF $GET(IBTRBRF)'=1
Begin DoDot:2
+39 WRITE !!,"No Diagnosis Information is currently on file.",!
+40 SET XX=$$ASKNEW("Add a new Diagnosis")
+41 QUIT
End DoDot:2
+42 IF $GET(IBTRBRF)=1
SET XX=0
+43 if XX<0
QUIT
+44 ; Get the .01 value
SET DXTYPE=$$DXTYPE(IBTRIEN)
+45 ; None entered
IF DXTYPE=""
SET XX=-1
QUIT
+46 SET IBNEW=1
SET XX=DXTYPE
+47 SET FDA(356.223,"+1,"_IBTRIEN_",",.01)=DXTYPE
+48 ; File the new line
DO UPDATE^DIE("","FDA","RETIEN")
+49 QUIT
End DoDot:1
QUIT $SELECT($ORDER(RETIEN(0)):RETIEN($ORDER(RETIEN(0))),1:XX)
+50 ;
+51 ; Next display all of the current Diagnoses and let the user select one
+52 SET H1="# Type Diagnosis"
+53 IF $GET(IBTRBRF)'=1
SET H1=H1_" Date DX Known"
+54 SET H2="-- ----- ---------"
+55 IF $GET(IBTRBRF)'=1
SET H2=H2_" -------------"
+56 SET L1="The following Diagnoses are currently on file."
+57 SET L2="Enter the # of a Diagnosis to edit, 'NEW' to add one or press Return to skip."
+58 SET XX=$$SELENT(.DXDATA,H1,H2,L1,L2,MAX,"",SECT)
+59 IF XX?1"D".N
Begin DoDot:1
+60 SET (XX,ENTNUM)=$PIECE(XX,"D",2)
+61 SET XX=$PIECE(DXDATA(XX),U)
+62 DO DELDX(IBTRIEN,XX)
+63 WRITE !,"Entry #",ENTNUM," has been deleted."
End DoDot:1
QUIT -3
+64 IF XX<0
QUIT XX
+65 IF XX=0
Begin DoDot:1
+66 ; Get the .01 value
SET DXTYPE=$$DXTYPE(IBTRIEN)
+67 ; None entered
IF DXTYPE=""
SET XX=-1
QUIT
+68 SET XX=DXTYPE
+69 SET IBNEW=1
+70 SET FDA(356.223,"+1,"_IBTRIEN_",",.01)=DXTYPE
+71 ; File the new line
DO UPDATE^DIE("","FDA","RETIEN")
End DoDot:1
QUIT $SELECT($ORDER(RETIEN(0)):RETIEN($ORDER(RETIEN(0))),1:XX)
+72 QUIT $PIECE(DXDATA(XX),"^",1)
+73 ;
DXTYPE(IBTRIEN) ; Prompts the user to enter the .01 (Diagnosis Type) field of
+1 ; the diagnosis multiple
+2 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+3 ; Returns: IEN of the selected Diagnosis Type or "" of not entered
+4 NEW DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+5 SET DA(1)=IBTRIEN
SET DA=$PIECE($GET(^IBT(356.22,IBTRIEN,3,0)),"^",3)+1
+6 SET DIR(0)="356.223,.01"
SET DIR("A")=" Diagnosis Qualifier"
+7 DO ^DIR
+8 if $DATA(DIRUT)
QUIT ""
+9 QUIT $PIECE(Y,"^",1)
+10 ;
DELDX(IBTRIEN,IEN) ; Checks to see if the user entered 'NEW' to create a new
+1 ; Diagnosis Line and didn't enter any data for it or selected a multiple to
+2 ; to be deleted. If so, the empty or selected multiple 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 Diagnosis line is deleted (Potentially)
+7 NEW DA,DIK,DXIEN,X,XX,Y
+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),3,"
+12 ; Delete the multiple
DO ^DIK
End DoDot:1
QUIT
+13 ;
+14 ; Last Multiple IEN
SET DXIEN=+$PIECE($GET(^IBT(356.22,IBTRIEN,3,0)),"^",3)
+15 if 'DXIEN
QUIT
+16 SET XX=$GET(^IBT(356.22,IBTRIEN,3,DXIEN,0))
+17 ; Remove .01 field
SET $PIECE(XX,"^",1)=""
+18 ; 0 node data exists
if $TRANSLATE(XX,"^","")'=""
QUIT
+19 SET DA(1)=IBTRIEN
SET DA=DXIEN
+20 SET DIK="^IBT(356.22,DA(1),3,"
+21 ; Delete the multiple
DO ^DIK
+22 QUIT
+23 ;
ASKNEW(PROMPT,DEFAULT) ;EP
+1 ; Ask if user wants to create a new entry
+2 ; Input: PROMPT - Yes/No question to ask the user
+3 ; DEFALT - Default Answer
+4 ; Optional, if not passed, set to 'YES'
+5 ; Returns: 0 - User wants to add a new Entry
+6 ; -1 - User doesn't want to add a new entry
+7 ; -2 - User wants to exit template
+8 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,XX,Y
+9 if '$DATA(DEFAULT)
SET DEFAULT="YES"
+10 SET XX=$PIECE(PROMPT,"Add ",2)
+11 SET DIR("?")="Select NO to skip this section. Select YES to enter "_XX_"."
+12 SET DIR(0)="Y"
SET DIR("A")=PROMPT
SET DIR("B")=DEFAULT
A1 ;
+1 DO ^DIR
+2 IF Y?1"^"1.E
DO JUMPERR^IBTRH5H
GOTO A1
+3 ; User Pressed ^
if $DATA(DUOUT)
QUIT -2
+4 ; User timed out
if $DATA(DTOUT)
QUIT -1
+5 IF Y=0
QUIT -1
+6 QUIT 1
+7 ;
SELENT(ARRAY,H1,H2,L1,L2,MAX,INDENT,SECT) ; Select an entry to add/edit from a list
+1 ; Input: ARRAY() - Array of multiple lines to be displayed
+2 ; H1 - 1st line of Header Information
+3 ; H2 - 2nd line of Header Information
+4 ; L1 - 1st line of DIR display
+5 ; L2 - Selection line text
+6 ; MAX - Multiple Description
+7 ; If passed, entering a new line is not allowed
+8 ; Optional, defaults to "" if not passed
+9 ; INDENT - 1 to indent 2 spaces
+10 ; Optional, defaults to 0
+11 ; SECT - Section Header
+12 ; Returns: # - User wants to edit Entry #
+13 ; 0 - User wants to Add a new Entry
+14 ; -1 - User wants to skip this section
+15 ; -2 - User wants to exit template
+16 NEW DEL,DIR,DIROUT,DIRUT,DOK,DTOUT,DUOUT,IX,LN,X,XX,Y,YY
+17 if '$DATA(MAX)
SET MAX=""
+18 if '$DATA(INDENT)
SET INDENT=0
+19 if '$DATA(SECT)
SET SECT=""
+20 SET DIR(0)="FO"
SET LN=0
+21 SET LN=LN+1
SET DIR("A",LN)=L1
+22 SET LN=LN+1
SET DIR("A",LN)=" "
+23 SET LN=LN+1
SET DIR("A",LN)=H1
+24 SET LN=LN+1
SET DIR("A",LN)=H2
+25 SET IX=""
+26 FOR
Begin DoDot:1
+27 SET IX=$ORDER(ARRAY(IX))
+28 if IX=""
QUIT
+29 SET LN=LN+1
SET DIR("A",LN)=$PIECE(ARRAY(IX),"^",2)
End DoDot:1
if IX=""
QUIT
+30 SET LN=LN+1
SET DIR("A",LN)=" "
+31 SET LN=LN+1
SET DIR("A",LN)=L2
+32 SET DIR("A")=$SELECT(INDENT:" ",1:"")_"Selection #"
+33 WRITE !!
SELE1 ;
+1 ;S XX="Select NO to skip this section. Select YES to enter "_SECT_"."
+2 SET XX="To delete an entry from the list, select D followed by the "
+3 SET XX=XX_"number of the entry you wish to delete."
+4 SET DIR("?")=XX
+5 DO ^DIR
+6 SET DOK=1
+7 ; Convert to Upper
SET Y=$$UP^XLFSTR(Y)
+8 IF Y?1"D".N
Begin DoDot:1
+9 SET XX=$PIECE(Y,"D",2)
+10 ; Selected Entry to delete
IF XX>0
IF XX'>CNT
IF XX?.N
QUIT
+11 SET DOK=0
+12 DO SELERR(INDENT)
End DoDot:1
if DOK
QUIT Y
+13 if 'DOK
GOTO SELE1
+14 IF Y?1"^"1.E
DO JUMPERR^IBTRH5H
GOTO SELE1
+15 ; User pressed ^
IF $DATA(DUOUT)
QUIT -2
+16 ; User timed out
IF $DATA(DTOUT)
QUIT -1
+17 ; User pressed return
IF Y=""
QUIT -1
+18 SET XX=$$UP^XLFSTR(Y)
+19 ; User wants to enter a new one
SET YY=$SELECT((XX="NEW")!(XX="N")!(XX="NE"):1,1:0)
+20 IF MAX'=""
IF YY
Begin DoDot:1
+21 WRITE *7,!!,$SELECT(INDENT:" ",1:"")
+22 WRITE "The maximum Number of "_MAX_" have already been entered.",!
+23 ;JWS;IB*2.0*592
+24 IF +CNT>21
READ !!,"Press <ENTER> to continue",X:30
End DoDot:1
GOTO SELE1
+25 ; Creating a new one
if YY
QUIT 0
+26 ; Selected Entry
IF XX>0
IF XX'>CNT
IF XX?.N
QUIT XX
+27 DO SELERR(INDENT)
+28 GOTO SELE1
+29 ;
SELERR(INDENT) ; Multiple Selection error
+1 ; Input: INDENT - 1 to indent error message display
+2 WRITE !!,*7,$SELECT(INDENT:" ",1:"")
+3 WRITE "Enter a number from 1-",CNT,". Enter NEW to enter a new entry."
+4 WRITE !,$SELECT(INDENT:" ",1:"")
+5 WRITE "To delete an entry from the list, select D followed by the "
+6 WRITE !,$SELECT(INDENT:" ",1:"")
+7 WRITE "number of the entry you wish to remove. Press return to skip selection."
+8 WRITE !!
+9 QUIT
