IBJPC1 ;ALB/FA - Site Parameter HCSR Screens, Nodes 63-66 ;03-JUN-2014
;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
;;Per VA Directive 6402, this routine should not be modified.
;;
;
EN(WHICH) ;EP
; Main entry point for HCSR Site Parameters, nodes 63-66
; Input: WHICH - 1 - Using template IBJP HCSR CLINICS
; 2 - Using template IBJP HCSR WARDS
; 3 - Using template IBJP HCSR ADM INSCO
; 4 - Using template IBJP HCSR APPT INSCO
N TEMPLATE
S TEMPLATE=$S(WHICH=1:"IBJP HCSR CLINICS",WHICH=2:"IBJP HCSR WARDS",1:"")
S:TEMPLATE="" TEMPLATE=$S(WHICH=3:"IBJP HCSR ADM INSCO",1:"IBJP HCSR APPT INSCO")
D EN^VALM(TEMPLATE)
Q
;
HDR(WHICH) ;EP
; Header code for HCSR Site Parameters, nodes 63-66
; Input: WHICH - 1 - Using template IBJP HCSR CLINICS
; 2 - Using template IBJP HCSR WARDS
; 3 - Using template IBJP HCSR ADM INSCO
; 4 - Using template IBJP HCSR APPT INSCO
;
S VALMHDR(1)="Only authorized persons may edit this data."
S:WHICH=1 VALMHDR(2)="Clinics Included in the Search:"
S:WHICH=2 VALMHDR(2)="Wards Included in the Search:"
S:WHICH=3 VALMHDR(2)="Insurance Companies Included in the Admissions Search:"
S:WHICH=4 VALMHDR(2)="Insurance Companies Included in the Appointment Search:"
Q
;
INIT(WHICH) ;EP
; Initialize variables and list array
; Input: WHICH - 1 - Using template IBJP HCSR CLINICS
; 2 - Using template IBJP HCSR WARDS
; 3 - Using template IBJP HCSR ADM INSCO
; 4 - Using template IBJP HCSR APPT INSCO
; Output: ^TMP("IBJPC1",$J) - Body lines to display for specified template
K ^TMP("IBJPC1",$J),^TMP($J,"IBJPC1IX")
D BLD(WHICH)
Q
;
BLD(WHICH) ; Build screen array, no variables required for input
; Input: WHICH - 1 - Using template IBJP HCSR CLINICS
; 2 - Using template IBJP HCSR WARDS
; 3 - Using template IBJP HCSR ADM INSCO
; 4 - Using template IBJP HCSR APPT INSCO
; Output: ^TMP("IBJPC1",$J) - Body lines to display for specified template
;
N ALLPYR,CNT,ENTRIES,LINE,NAME,NAMEIEN,NODE,NODE0,TOTPYR,Z
S VALMCNT=0
S NODE=$S(WHICH=1:63,WHICH=2:64,WHICH=3:66,1:65)
S (Z,CNT)=0
F D Q:+Z=0
. S Z=$O(^IBE(350.9,1,NODE,Z))
. Q:+Z=0
. S NODE0=$G(^IBE(350.9,1,NODE,Z,0)),NAMEIEN=+$P(NODE0,"^",1)
. I NAMEIEN>0 D
. . S CNT=CNT+1,NAME=$$EXTERNAL^DILFD(350.9_NODE,.01,"",NAMEIEN)
. . I NAME'="" D
. . . S ENTRIES(NAME,CNT)=NAMEIEN,ENTRIES(NAME,CNT,"IEN")=Z
I '$D(ENTRIES) D Q
. S LINE=$$SETL("","","** No entries found **",29,22)
. S ^TMP("IBJPC1",$J,1,0)=LINE
S NAME=""
F D Q:NAME=""
.S NAME=$O(ENTRIES(NAME)) Q:NAME=""
.S Z=0 F D Q:Z=""
..S Z=$O(ENTRIES(NAME,Z)) Q:Z=""
..S VALMCNT=VALMCNT+1
..;
..; Build the display line - Insurances have multi-columns
..I WHICH<3 D
...S LINE=$$SETL("",VALMCNT,"",1,4)
...S LINE=$$SETL(LINE,NAME,"",6,30)
...S ALLPYR=$$ISALL^IBJPC3(NODE,ENTRIES(NAME,Z,"IEN"))
...I ALLPYR S LINE=$$SETL(LINE,"- for all payers","",37,42)
...I 'ALLPYR D
....S TOTPYR=$$GETTOT^IBJPC3(NODE,ENTRIES(NAME,Z,"IEN"))
....I 'TOTPYR S LINE=$$SETL(LINE,"- for no payers","",37,42) Q
....S LINE=$$SETL(LINE,"- for "_TOTPYR_" payer"_$S(TOTPYR>1:"s",1:""),"",37,42)
....Q
...Q
..E S LINE=$$BLDLN(VALMCNT,NAME,ENTRIES(NAME,Z))
..D SET^VALM10(VALMCNT,LINE,VALMCNT)
..S ^TMP($J,"IBJPC1IX",VALMCNT)=ENTRIES(NAME,Z,"IEN")
..Q
.Q
Q
;
BLDLN(CTR,NAME,IEN) ; Builds a line to display and insurance
; Input: CTR - Current Line Counter
; NAME - Insurance Company Name
; IEN - IEN of the insurance to be displayed
; Output: LINE - Formatted for setting into the list display
N LINE,XX
S LINE=$$SETSTR^VALM1(CTR,"",1,4) ; Entry #
S LINE=$$SETSTR^VALM1(NAME,LINE,6,30) ; Insurance Name
S XX=$$GET1^DIQ(36,IEN_",",.111)
S LINE=$$SETSTR^VALM1(XX,LINE,39,35) ; Address line1
S XX=$$GET1^DIQ(36,IEN_",",.115,"I")
S XX=$$GET1^DIQ(5,XX_",",1) ; State Abbreviation
S LINE=$$SETSTR^VALM1(XX,LINE,77,2) ; State
Q LINE
;
SETL(LINE,DATA,LABEL,COL,LNG) ; Creates a line of data to be set into the body
; of the worklist
; Input: LINE - Current line being created
; DATA - Information to be added to the end of the current line
; LABEL - Label to describe the information being added
; COL - Column position in line to add information add
; LNG - Maximum length of data information to include on the line
; Returns: Line updated with added information
S LINE=LINE_$J("",(COL-$L(LABEL)-$L(LINE)))_LABEL_$E(DATA,1,LNG)
Q LINE
;
HELP(WHICH) ;EP
; Help code
; Input: WHICH - 1 - Using template IBJP HCSR CLINICS
; 2 - Using template IBJP HCSR WARDS
; 3 - Using template IBJP HCSR ADM INSCO
; 4 - Using template IBJP HCSR APPT INSCO
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT(WHICH) ;EP
; Exit code
; Input: WHICH - 1 - Using template IBJP HCSR CLINICS
; 2 - Using template IBJP HCSR WARDS
; 3 - Using template IBJP HCSR ADM INSCO
; 4 - Using template IBJP HCSR APPT INSCO
K ^TMP("IBJPC1",$J),^TMP($J,"IBJPC1IX")
D CLEAR^VALM1
Q
;
ADD(WHICH) ;EP
; Listman Protocol Action to add an entry to the specified Site Parameter node
; Input: WHICH - 1 - Adding to the Clinic Search inclusion list
; 2 - Adding to the Ward Search inclusion list
; 3 - Adding to the Admission Search inclusion list
; 4 - Adding to the Appointment Search inclusion list
N DA,DIK,DIR
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,FDA,IEN,IENS,INSM,INSMC
N NODE,NAME,NAMEU,NODE0,TYPE,X,XX,Y,Z,Z1,CNT
S NODE=$S(WHICH=1:63,WHICH=2:64,WHICH=3:66,1:65)
S TYPE=$S(WHICH=1:"Clinic",WHICH=2:"Ward",1:"Insurance Company")
S VALMBCK="R" ; Refresh screen on return
Q:'$$LOCK(NODE) ; Couldn't lock for adding
D FULL^VALM1
D WARNMSG ; Display warning message
;
I '$$ENTSEL(NODE,.IENS,WHICH) D Q ; Select entry(s) to be added
. S VALMSG="No "_TYPE_" selected"
. D UNLOCK(NODE)
I ($O(IENS(""))'=$O(IENS(""),-1)) D
. I NODE>64 S TYPE="Insurance Companies" Q
. S TYPE=TYPE_"s"
;
; check for 'MEDICARE/MEDICAID' insurance companies
I WHICH>2 D
.S INSMC=0,IEN=0 F D Q:'IEN
..S IEN=$O(IENS(IEN)) Q:'IEN
..S NAME=$$EXTERNAL^DILFD(350.9_NODE,.01,"",+IEN)
..S NAMEU=$$UP^XLFSTR(NAME)
..I (NAMEU["MEDICAID")!(NAMEU["MEDICARE") S INSMC=INSMC+1,INSM(INSMC)=NAME
..Q
.I $D(INSM) D
..S:INSMC=1 XX="The following Insurance Company record"
..S:INSMC>1 XX="The following "_INSMC_" Insurance Company records"
..S XX=XX_$S(INSMC>1:" are ",1:" is ")_"for MEDICARE or MEDICAID:"
..S DIR(0)="EA",DIR("A",1)=XX
..S Z1=0,Z=1 F D Q:'Z1
...S Z1=$O(INSM(Z1)) Q:'Z1
...S Z=Z+1,DIR("A",Z)=INSM(Z1)
...Q
..S DIR("A")="Press RETURN to continue "
..D ^DIR
..Q
.; Add the selected entries into the list for ins. companies
.S IEN="",CNT=0 F D Q:IEN=""
..S IEN=$O(IENS(IEN)) Q:IEN=""
..S CNT=CNT+1
..S FDA("350.9"_NODE,"+1,1,",.01)=IEN
..S FDA("350.9"_NODE,"+1,1,",.02)=0
..D UPDATE^DIE("","FDA")
..Q
.Q
D UNLOCK(NODE) ; Unlock the Node
;
I WHICH>2,$D(IENS) D
. S DIR(0)="EA",Z=1
. S DIR("A",Z)=" ",Z=Z+1
. S DIR("A",Z)="The following "_CNT_" "_TYPE_" record"_$S(CNT>1:"s",1:"")_" added:",Z=Z+1
. S Z1=0
. F S Z1=$O(IENS(Z1)) Q:'Z1 D
.. S NAME=$$EXTERNAL^DILFD(350.9_NODE,.01,"",+Z1)
.. S IENS(Z1)=NAME,DIR("A",Z)=NAME,Z=Z+1
.. Q
. S DIR("A",Z)=" ",Z=Z+1
. S DIR("A")="Press RETURN to continue "
. D ^DIR
;
D INIT(WHICH) ; Rebuild list body
S VALMSG="Added "_TYPE
Q
;
DEL(WHICH) ;EP
; Listman Protocol Action to delete an entry from the specified Site Parameter
; node
; Input: WHICH - 1 - Deleting from the Clinic Search inclusion list
; 2 - Deleting from the Ward Search inclusion list
; 3 - Deleting from the Admission Search inclusion list
; 4 - Deleting from to the Appt Search exclusion list
;
N CNT,DA,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LIST,NAME
N NODE,NODE0,SELSTR,STR,TYPE,X,XX,Y,Z,Z1
S NODE=$S(WHICH=1:63,WHICH=2:64,WHICH=3:66,1:65)
S TYPE=$S(WHICH=1:"Clinic",WHICH=2:"Ward",1:"Insurance Company")
S VALMBCK="R" ; Refresh screen on return
Q:'$$LOCK(NODE) ; Couldn't lock for deletion
D FULL^VALM1
D WARNMSG ; Display warning message
S STR=$$SELEVENT^IBTRH1(0,"",.SELSTR,1,"IBJPC1IX")
;
; Check for 'MEDICARE/MEDICAID' entries (ins. companies only)
I STR'="" D
. F Z=1:1:$L(STR,",") D
. . S Z1=$P(STR,",",Z),NODE0=$G(^IBE(350.9,1,NODE,Z1,0))
. . S NAME=$$EXTERNAL^DILFD(350.9_NODE,.01,"",+$P(NODE0,"^",1))
. . S LIST(Z1)=NAME
;
; Delete the selected entries from the list
S DA(1)=1,(CNT,DA)=0
F S DA=$O(LIST(DA)) Q:'DA D
. S CNT=CNT+1,DIK="^IBE(350.9,"_DA(1)_","_NODE_","
. D ^DIK
S DIR(0)="EA",Z=1
S DIR("A",Z)=" ",Z=Z+1
I STR="" S DIR("A",Z)="No "_TYPE_" records selected",Z=Z+1
I STR'="" D
. I $D(LIST) D
. . S DIR("A",Z)="The following "_CNT_" "_TYPE_" record"_$S(CNT>1:"s",1:"")_" deleted:",Z=Z+1
. . S Z1=0
. . F S Z1=$O(LIST(Z1)) Q:'Z1 S DIR("A",Z)=LIST(Z1),Z=Z+1
S DIR("A",Z)=" ",Z=Z+1
S DIR("A")="Press RETURN to continue "
D ^DIR
D UNLOCK(NODE) ; Unlock Site Parameter node
I STR'="" D INIT(WHICH) ; Rebuild list body
Q
;
WARNMSG ;EP
; Displays a warning message to the user when they modify site parameters
; Input: None
; Output: Warning message displayed
W !!,"**Warning**"
W !,"Changing the value in CPAC/TRICARE/CHAMPVA parameters will affect the Health"
W !,"Care Services Review Worklist.",!!
Q
;
ENTSEL(NODE,IENS,WHICHF) ; Selects an entry to be added to the specified Site Parameter Node
; Input:
; NODE - Site Parameter node where the data resides
; WHICHF - 1 - Adding/Deleting to the Clinic Search
; inclusion list
; 2 - Adding/Deleting to the Ward Search inclusion
; list
; 3 - Adding/Deleting to the Admission Search
; exclusion list
; 4 - Adding/Deleting to the Appointment Search
; exclusion list
; Output: IENS - Array of selected IEN(s), "" if not selected
; Returns: 1 - At least one IEN selected, 0 otherwise
N DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FDA,IENARY,IX,STOP,STOP2,TYPE,X,XX,Y,Z
K IENS
S STOP=0
S TYPE=$S(NODE=63:"a Clinic",NODE=64:"a Ward",1:"an Insurance Company")
S DIC=$S(NODE=63:44,NODE=64:42,1:36)
S DIC(0)="AEQM"
S DIC("A")="Select "_TYPE_" to be added: "
;
; Set the Add filter
S XX="I '$D(^IBE(350.9,1,"_NODE_",""B"",Y))"
S XX=XX_"&'$D(IENS(+Y))"
S DIC("S")=XX
F D Q:STOP
.D ^DIC
.I Y'>0 S STOP=1 Q
.S IENS(+Y)=""
.D:WHICHF>2 ADDBYEID(+Y,.IENS)
.; create entry for clinic / ward - need to do it here for payer assoc.
.I WHICHF'>2 D
..K FDA,IENARY
..S FDA("350.9"_NODE,"+1,1,",.01)=+Y
..S FDA("350.9"_NODE,"+1,1,",.02)=0
..D UPDATE^DIE("","FDA","IENARY")
..I +$G(IENARY(1)) D ADDPYR1^IBJPC3(NODE,IENARY(1))
..Q
.Q
;
I '$D(IENS) Q 0 ; No IENS selected
Q 1
;
ADDBYEID(IEN,IENS) ; Asks the user if they also want to add all Insurance
; companies with the same electronic payer ID.
; Input: IEN - IEN of the insurance company to be added
; IENS() - Current array of insurance companies to be added
; Output: IENS() - Updated array of insurance companies to be added
N DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,PAYID,SPAYIEN,X,XX,Y
S XX="Select YES to also add every insurance company with the same "
S XX=XX_"electronic Payer ID."
S DIR("?")=XX
S DIR(0)="Y"
S DIR("A")="Include all payers with the same electronic Payer ID?"
S DIR("B")="NO"
D ^DIR
Q:Y=0
S PAYID=$$GET1^DIQ(36,IEN_",",3.1,"I")
Q:PAYID=""
S SPAYIEN=""
F D Q:SPAYIEN=""
. S SPAYIEN=$O(^DIC(36,"AC",PAYID,SPAYIEN))
. Q:SPAYIEN=""
. I $D(^IBE(350.9,1,NODE,"B",SPAYIEN)) Q ;eliminate duplicates
. S IENS(SPAYIEN)=""
Q
;
LOCK(NODE) ;EP
; Attempt to lock the Site Parameter node that is being worked
; Input: NODE - Site Parameter node where the data resides
; Returns: 1 - Successfully locked
; 0 - Not successfully locked and an error message is
; displayed
N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,TEXT,X,Y
L +^IBE(350.9,1,NODE):1
I '$T D Q 0
. S:NODE=62 TEXT="Other Parameters."
. S:NODE=63 TEXT="Clinics Included in the Search List."
. S:NODE=64 TEXT="Ward Included in the Search List."
. S:NODE=65 TEXT="Insurances Included in the Appointment Search List."
. S:NODE=66 TEXT="Insurances Included in the Admissions Search List."
. W @IOF,"Someone else is editing the "_TEXT
. W !,"Please Try again later"
. D PAUSE^VALM1
Q 1
;
UNLOCK(NODE) ;EP
; Unlocks the Site Parameter node that is being worked
; Input: NODE - Site Parameter node where the data resides
L -^IBE(350.9,1,NODE)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJPC1 13582 printed Dec 13, 2024@02:23:29 Page 2
IBJPC1 ;ALB/FA - Site Parameter HCSR Screens, Nodes 63-66 ;03-JUN-2014
+1 ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;
+4 ;
EN(WHICH) ;EP
+1 ; Main entry point for HCSR Site Parameters, nodes 63-66
+2 ; Input: WHICH - 1 - Using template IBJP HCSR CLINICS
+3 ; 2 - Using template IBJP HCSR WARDS
+4 ; 3 - Using template IBJP HCSR ADM INSCO
+5 ; 4 - Using template IBJP HCSR APPT INSCO
+6 NEW TEMPLATE
+7 SET TEMPLATE=$SELECT(WHICH=1:"IBJP HCSR CLINICS",WHICH=2:"IBJP HCSR WARDS",1:"")
+8 if TEMPLATE=""
SET TEMPLATE=$SELECT(WHICH=3:"IBJP HCSR ADM INSCO",1:"IBJP HCSR APPT INSCO")
+9 DO EN^VALM(TEMPLATE)
+10 QUIT
+11 ;
HDR(WHICH) ;EP
+1 ; Header code for HCSR Site Parameters, nodes 63-66
+2 ; Input: WHICH - 1 - Using template IBJP HCSR CLINICS
+3 ; 2 - Using template IBJP HCSR WARDS
+4 ; 3 - Using template IBJP HCSR ADM INSCO
+5 ; 4 - Using template IBJP HCSR APPT INSCO
+6 ;
+7 SET VALMHDR(1)="Only authorized persons may edit this data."
+8 if WHICH=1
SET VALMHDR(2)="Clinics Included in the Search:"
+9 if WHICH=2
SET VALMHDR(2)="Wards Included in the Search:"
+10 if WHICH=3
SET VALMHDR(2)="Insurance Companies Included in the Admissions Search:"
+11 if WHICH=4
SET VALMHDR(2)="Insurance Companies Included in the Appointment Search:"
+12 QUIT
+13 ;
INIT(WHICH) ;EP
+1 ; Initialize variables and list array
+2 ; Input: WHICH - 1 - Using template IBJP HCSR CLINICS
+3 ; 2 - Using template IBJP HCSR WARDS
+4 ; 3 - Using template IBJP HCSR ADM INSCO
+5 ; 4 - Using template IBJP HCSR APPT INSCO
+6 ; Output: ^TMP("IBJPC1",$J) - Body lines to display for specified template
+7 KILL ^TMP("IBJPC1",$JOB),^TMP($JOB,"IBJPC1IX")
+8 DO BLD(WHICH)
+9 QUIT
+10 ;
BLD(WHICH) ; Build screen array, no variables required for input
+1 ; Input: WHICH - 1 - Using template IBJP HCSR CLINICS
+2 ; 2 - Using template IBJP HCSR WARDS
+3 ; 3 - Using template IBJP HCSR ADM INSCO
+4 ; 4 - Using template IBJP HCSR APPT INSCO
+5 ; Output: ^TMP("IBJPC1",$J) - Body lines to display for specified template
+6 ;
+7 NEW ALLPYR,CNT,ENTRIES,LINE,NAME,NAMEIEN,NODE,NODE0,TOTPYR,Z
+8 SET VALMCNT=0
+9 SET NODE=$SELECT(WHICH=1:63,WHICH=2:64,WHICH=3:66,1:65)
+10 SET (Z,CNT)=0
+11 FOR
Begin DoDot:1
+12 SET Z=$ORDER(^IBE(350.9,1,NODE,Z))
+13 if +Z=0
QUIT
+14 SET NODE0=$GET(^IBE(350.9,1,NODE,Z,0))
SET NAMEIEN=+$PIECE(NODE0,"^",1)
+15 IF NAMEIEN>0
Begin DoDot:2
+16 SET CNT=CNT+1
SET NAME=$$EXTERNAL^DILFD(350.9_NODE,.01,"",NAMEIEN)
+17 IF NAME'=""
Begin DoDot:3
+18 SET ENTRIES(NAME,CNT)=NAMEIEN
SET ENTRIES(NAME,CNT,"IEN")=Z
End DoDot:3
End DoDot:2
End DoDot:1
if +Z=0
QUIT
+19 IF '$DATA(ENTRIES)
Begin DoDot:1
+20 SET LINE=$$SETL("","","** No entries found **",29,22)
+21 SET ^TMP("IBJPC1",$JOB,1,0)=LINE
End DoDot:1
QUIT
+22 SET NAME=""
+23 FOR
Begin DoDot:1
+24 SET NAME=$ORDER(ENTRIES(NAME))
if NAME=""
QUIT
+25 SET Z=0
FOR
Begin DoDot:2
+26 SET Z=$ORDER(ENTRIES(NAME,Z))
if Z=""
QUIT
+27 SET VALMCNT=VALMCNT+1
+28 ;
+29 ; Build the display line - Insurances have multi-columns
+30 IF WHICH<3
Begin DoDot:3
+31 SET LINE=$$SETL("",VALMCNT,"",1,4)
+32 SET LINE=$$SETL(LINE,NAME,"",6,30)
+33 SET ALLPYR=$$ISALL^IBJPC3(NODE,ENTRIES(NAME,Z,"IEN"))
+34 IF ALLPYR
SET LINE=$$SETL(LINE,"- for all payers","",37,42)
+35 IF 'ALLPYR
Begin DoDot:4
+36 SET TOTPYR=$$GETTOT^IBJPC3(NODE,ENTRIES(NAME,Z,"IEN"))
+37 IF 'TOTPYR
SET LINE=$$SETL(LINE,"- for no payers","",37,42)
QUIT
+38 SET LINE=$$SETL(LINE,"- for "_TOTPYR_" payer"_$SELECT(TOTPYR>1:"s",1:""),"",37,42)
+39 QUIT
End DoDot:4
+40 QUIT
End DoDot:3
+41 IF '$TEST
SET LINE=$$BLDLN(VALMCNT,NAME,ENTRIES(NAME,Z))
+42 DO SET^VALM10(VALMCNT,LINE,VALMCNT)
+43 SET ^TMP($JOB,"IBJPC1IX",VALMCNT)=ENTRIES(NAME,Z,"IEN")
+44 QUIT
End DoDot:2
if Z=""
QUIT
+45 QUIT
End DoDot:1
if NAME=""
QUIT
+46 QUIT
+47 ;
BLDLN(CTR,NAME,IEN) ; Builds a line to display and insurance
+1 ; Input: CTR - Current Line Counter
+2 ; NAME - Insurance Company Name
+3 ; IEN - IEN of the insurance to be displayed
+4 ; Output: LINE - Formatted for setting into the list display
+5 NEW LINE,XX
+6 ; Entry #
SET LINE=$$SETSTR^VALM1(CTR,"",1,4)
+7 ; Insurance Name
SET LINE=$$SETSTR^VALM1(NAME,LINE,6,30)
+8 SET XX=$$GET1^DIQ(36,IEN_",",.111)
+9 ; Address line1
SET LINE=$$SETSTR^VALM1(XX,LINE,39,35)
+10 SET XX=$$GET1^DIQ(36,IEN_",",.115,"I")
+11 ; State Abbreviation
SET XX=$$GET1^DIQ(5,XX_",",1)
+12 ; State
SET LINE=$$SETSTR^VALM1(XX,LINE,77,2)
+13 QUIT LINE
+14 ;
SETL(LINE,DATA,LABEL,COL,LNG) ; Creates a line of data to be set into the body
+1 ; of the worklist
+2 ; Input: LINE - Current line being created
+3 ; DATA - Information to be added to the end of the current line
+4 ; LABEL - Label to describe the information being added
+5 ; COL - Column position in line to add information add
+6 ; LNG - Maximum length of data information to include on the line
+7 ; Returns: Line updated with added information
+8 SET LINE=LINE_$JUSTIFY("",(COL-$LENGTH(LABEL)-$LENGTH(LINE)))_LABEL_$EXTRACT(DATA,1,LNG)
+9 QUIT LINE
+10 ;
HELP(WHICH) ;EP
+1 ; Help code
+2 ; Input: WHICH - 1 - Using template IBJP HCSR CLINICS
+3 ; 2 - Using template IBJP HCSR WARDS
+4 ; 3 - Using template IBJP HCSR ADM INSCO
+5 ; 4 - Using template IBJP HCSR APPT INSCO
+6 SET X="?"
DO DISP^XQORM1
WRITE !!
+7 QUIT
+8 ;
EXIT(WHICH) ;EP
+1 ; Exit code
+2 ; Input: WHICH - 1 - Using template IBJP HCSR CLINICS
+3 ; 2 - Using template IBJP HCSR WARDS
+4 ; 3 - Using template IBJP HCSR ADM INSCO
+5 ; 4 - Using template IBJP HCSR APPT INSCO
+6 KILL ^TMP("IBJPC1",$JOB),^TMP($JOB,"IBJPC1IX")
+7 DO CLEAR^VALM1
+8 QUIT
+9 ;
ADD(WHICH) ;EP
+1 ; Listman Protocol Action to add an entry to the specified Site Parameter node
+2 ; Input: WHICH - 1 - Adding to the Clinic Search inclusion list
+3 ; 2 - Adding to the Ward Search inclusion list
+4 ; 3 - Adding to the Admission Search inclusion list
+5 ; 4 - Adding to the Appointment Search inclusion list
+6 NEW DA,DIK,DIR
+7 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,FDA,IEN,IENS,INSM,INSMC
+8 NEW NODE,NAME,NAMEU,NODE0,TYPE,X,XX,Y,Z,Z1,CNT
+9 SET NODE=$SELECT(WHICH=1:63,WHICH=2:64,WHICH=3:66,1:65)
+10 SET TYPE=$SELECT(WHICH=1:"Clinic",WHICH=2:"Ward",1:"Insurance Company")
+11 ; Refresh screen on return
SET VALMBCK="R"
+12 ; Couldn't lock for adding
if '$$LOCK(NODE)
QUIT
+13 DO FULL^VALM1
+14 ; Display warning message
DO WARNMSG
+15 ;
+16 ; Select entry(s) to be added
IF '$$ENTSEL(NODE,.IENS,WHICH)
Begin DoDot:1
+17 SET VALMSG="No "_TYPE_" selected"
+18 DO UNLOCK(NODE)
End DoDot:1
QUIT
+19 IF ($ORDER(IENS(""))'=$ORDER(IENS(""),-1))
Begin DoDot:1
+20 IF NODE>64
SET TYPE="Insurance Companies"
QUIT
+21 SET TYPE=TYPE_"s"
End DoDot:1
+22 ;
+23 ; check for 'MEDICARE/MEDICAID' insurance companies
+24 IF WHICH>2
Begin DoDot:1
+25 SET INSMC=0
SET IEN=0
FOR
Begin DoDot:2
+26 SET IEN=$ORDER(IENS(IEN))
if 'IEN
QUIT
+27 SET NAME=$$EXTERNAL^DILFD(350.9_NODE,.01,"",+IEN)
+28 SET NAMEU=$$UP^XLFSTR(NAME)
+29 IF (NAMEU["MEDICAID")!(NAMEU["MEDICARE")
SET INSMC=INSMC+1
SET INSM(INSMC)=NAME
+30 QUIT
End DoDot:2
if 'IEN
QUIT
+31 IF $DATA(INSM)
Begin DoDot:2
+32 if INSMC=1
SET XX="The following Insurance Company record"
+33 if INSMC>1
SET XX="The following "_INSMC_" Insurance Company records"
+34 SET XX=XX_$SELECT(INSMC>1:" are ",1:" is ")_"for MEDICARE or MEDICAID:"
+35 SET DIR(0)="EA"
SET DIR("A",1)=XX
+36 SET Z1=0
SET Z=1
FOR
Begin DoDot:3
+37 SET Z1=$ORDER(INSM(Z1))
if 'Z1
QUIT
+38 SET Z=Z+1
SET DIR("A",Z)=INSM(Z1)
+39 QUIT
End DoDot:3
if 'Z1
QUIT
+40 SET DIR("A")="Press RETURN to continue "
+41 DO ^DIR
+42 QUIT
End DoDot:2
+43 ; Add the selected entries into the list for ins. companies
+44 SET IEN=""
SET CNT=0
FOR
Begin DoDot:2
+45 SET IEN=$ORDER(IENS(IEN))
if IEN=""
QUIT
+46 SET CNT=CNT+1
+47 SET FDA("350.9"_NODE,"+1,1,",.01)=IEN
+48 SET FDA("350.9"_NODE,"+1,1,",.02)=0
+49 DO UPDATE^DIE("","FDA")
+50 QUIT
End DoDot:2
if IEN=""
QUIT
+51 QUIT
End DoDot:1
+52 ; Unlock the Node
DO UNLOCK(NODE)
+53 ;
+54 IF WHICH>2
IF $DATA(IENS)
Begin DoDot:1
+55 SET DIR(0)="EA"
SET Z=1
+56 SET DIR("A",Z)=" "
SET Z=Z+1
+57 SET DIR("A",Z)="The following "_CNT_" "_TYPE_" record"_$SELECT(CNT>1:"s",1:"")_" added:"
SET Z=Z+1
+58 SET Z1=0
+59 FOR
SET Z1=$ORDER(IENS(Z1))
if 'Z1
QUIT
Begin DoDot:2
+60 SET NAME=$$EXTERNAL^DILFD(350.9_NODE,.01,"",+Z1)
+61 SET IENS(Z1)=NAME
SET DIR("A",Z)=NAME
SET Z=Z+1
+62 QUIT
End DoDot:2
+63 SET DIR("A",Z)=" "
SET Z=Z+1
+64 SET DIR("A")="Press RETURN to continue "
+65 DO ^DIR
End DoDot:1
+66 ;
+67 ; Rebuild list body
DO INIT(WHICH)
+68 SET VALMSG="Added "_TYPE
+69 QUIT
+70 ;
DEL(WHICH) ;EP
+1 ; Listman Protocol Action to delete an entry from the specified Site Parameter
+2 ; node
+3 ; Input: WHICH - 1 - Deleting from the Clinic Search inclusion list
+4 ; 2 - Deleting from the Ward Search inclusion list
+5 ; 3 - Deleting from the Admission Search inclusion list
+6 ; 4 - Deleting from to the Appt Search exclusion list
+7 ;
+8 NEW CNT,DA,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LIST,NAME
+9 NEW NODE,NODE0,SELSTR,STR,TYPE,X,XX,Y,Z,Z1
+10 SET NODE=$SELECT(WHICH=1:63,WHICH=2:64,WHICH=3:66,1:65)
+11 SET TYPE=$SELECT(WHICH=1:"Clinic",WHICH=2:"Ward",1:"Insurance Company")
+12 ; Refresh screen on return
SET VALMBCK="R"
+13 ; Couldn't lock for deletion
if '$$LOCK(NODE)
QUIT
+14 DO FULL^VALM1
+15 ; Display warning message
DO WARNMSG
+16 SET STR=$$SELEVENT^IBTRH1(0,"",.SELSTR,1,"IBJPC1IX")
+17 ;
+18 ; Check for 'MEDICARE/MEDICAID' entries (ins. companies only)
+19 IF STR'=""
Begin DoDot:1
+20 FOR Z=1:1:$LENGTH(STR,",")
Begin DoDot:2
+21 SET Z1=$PIECE(STR,",",Z)
SET NODE0=$GET(^IBE(350.9,1,NODE,Z1,0))
+22 SET NAME=$$EXTERNAL^DILFD(350.9_NODE,.01,"",+$PIECE(NODE0,"^",1))
+23 SET LIST(Z1)=NAME
End DoDot:2
End DoDot:1
+24 ;
+25 ; Delete the selected entries from the list
+26 SET DA(1)=1
SET (CNT,DA)=0
+27 FOR
SET DA=$ORDER(LIST(DA))
if 'DA
QUIT
Begin DoDot:1
+28 SET CNT=CNT+1
SET DIK="^IBE(350.9,"_DA(1)_","_NODE_","
+29 DO ^DIK
End DoDot:1
+30 SET DIR(0)="EA"
SET Z=1
+31 SET DIR("A",Z)=" "
SET Z=Z+1
+32 IF STR=""
SET DIR("A",Z)="No "_TYPE_" records selected"
SET Z=Z+1
+33 IF STR'=""
Begin DoDot:1
+34 IF $DATA(LIST)
Begin DoDot:2
+35 SET DIR("A",Z)="The following "_CNT_" "_TYPE_" record"_$SELECT(CNT>1:"s",1:"")_" deleted:"
SET Z=Z+1
+36 SET Z1=0
+37 FOR
SET Z1=$ORDER(LIST(Z1))
if 'Z1
QUIT
SET DIR("A",Z)=LIST(Z1)
SET Z=Z+1
End DoDot:2
End DoDot:1
+38 SET DIR("A",Z)=" "
SET Z=Z+1
+39 SET DIR("A")="Press RETURN to continue "
+40 DO ^DIR
+41 ; Unlock Site Parameter node
DO UNLOCK(NODE)
+42 ; Rebuild list body
IF STR'=""
DO INIT(WHICH)
+43 QUIT
+44 ;
WARNMSG ;EP
+1 ; Displays a warning message to the user when they modify site parameters
+2 ; Input: None
+3 ; Output: Warning message displayed
+4 WRITE !!,"**Warning**"
+5 WRITE !,"Changing the value in CPAC/TRICARE/CHAMPVA parameters will affect the Health"
+6 WRITE !,"Care Services Review Worklist.",!!
+7 QUIT
+8 ;
ENTSEL(NODE,IENS,WHICHF) ; Selects an entry to be added to the specified Site Parameter Node
+1 ; Input:
+2 ; NODE - Site Parameter node where the data resides
+3 ; WHICHF - 1 - Adding/Deleting to the Clinic Search
+4 ; inclusion list
+5 ; 2 - Adding/Deleting to the Ward Search inclusion
+6 ; list
+7 ; 3 - Adding/Deleting to the Admission Search
+8 ; exclusion list
+9 ; 4 - Adding/Deleting to the Appointment Search
+10 ; exclusion list
+11 ; Output: IENS - Array of selected IEN(s), "" if not selected
+12 ; Returns: 1 - At least one IEN selected, 0 otherwise
+13 NEW DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FDA,IENARY,IX,STOP,STOP2,TYPE,X,XX,Y,Z
+14 KILL IENS
+15 SET STOP=0
+16 SET TYPE=$SELECT(NODE=63:"a Clinic",NODE=64:"a Ward",1:"an Insurance Company")
+17 SET DIC=$SELECT(NODE=63:44,NODE=64:42,1:36)
+18 SET DIC(0)="AEQM"
+19 SET DIC("A")="Select "_TYPE_" to be added: "
+20 ;
+21 ; Set the Add filter
+22 SET XX="I '$D(^IBE(350.9,1,"_NODE_",""B"",Y))"
+23 SET XX=XX_"&'$D(IENS(+Y))"
+24 SET DIC("S")=XX
+25 FOR
Begin DoDot:1
+26 DO ^DIC
+27 IF Y'>0
SET STOP=1
QUIT
+28 SET IENS(+Y)=""
+29 if WHICHF>2
DO ADDBYEID(+Y,.IENS)
+30 ; create entry for clinic / ward - need to do it here for payer assoc.
+31 IF WHICHF'>2
Begin DoDot:2
+32 KILL FDA,IENARY
+33 SET FDA("350.9"_NODE,"+1,1,",.01)=+Y
+34 SET FDA("350.9"_NODE,"+1,1,",.02)=0
+35 DO UPDATE^DIE("","FDA","IENARY")
+36 IF +$GET(IENARY(1))
DO ADDPYR1^IBJPC3(NODE,IENARY(1))
+37 QUIT
End DoDot:2
+38 QUIT
End DoDot:1
if STOP
QUIT
+39 ;
+40 ; No IENS selected
IF '$DATA(IENS)
QUIT 0
+41 QUIT 1
+42 ;
ADDBYEID(IEN,IENS) ; Asks the user if they also want to add all Insurance
+1 ; companies with the same electronic payer ID.
+2 ; Input: IEN - IEN of the insurance company to be added
+3 ; IENS() - Current array of insurance companies to be added
+4 ; Output: IENS() - Updated array of insurance companies to be added
+5 NEW DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,PAYID,SPAYIEN,X,XX,Y
+6 SET XX="Select YES to also add every insurance company with the same "
+7 SET XX=XX_"electronic Payer ID."
+8 SET DIR("?")=XX
+9 SET DIR(0)="Y"
+10 SET DIR("A")="Include all payers with the same electronic Payer ID?"
+11 SET DIR("B")="NO"
+12 DO ^DIR
+13 if Y=0
QUIT
+14 SET PAYID=$$GET1^DIQ(36,IEN_",",3.1,"I")
+15 if PAYID=""
QUIT
+16 SET SPAYIEN=""
+17 FOR
Begin DoDot:1
+18 SET SPAYIEN=$ORDER(^DIC(36,"AC",PAYID,SPAYIEN))
+19 if SPAYIEN=""
QUIT
+20 ;eliminate duplicates
IF $DATA(^IBE(350.9,1,NODE,"B",SPAYIEN))
QUIT
+21 SET IENS(SPAYIEN)=""
End DoDot:1
if SPAYIEN=""
QUIT
+22 QUIT
+23 ;
LOCK(NODE) ;EP
+1 ; Attempt to lock the Site Parameter node that is being worked
+2 ; Input: NODE - Site Parameter node where the data resides
+3 ; Returns: 1 - Successfully locked
+4 ; 0 - Not successfully locked and an error message is
+5 ; displayed
+6 NEW DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,TEXT,X,Y
+7 LOCK +^IBE(350.9,1,NODE):1
+8 IF '$TEST
Begin DoDot:1
+9 if NODE=62
SET TEXT="Other Parameters."
+10 if NODE=63
SET TEXT="Clinics Included in the Search List."
+11 if NODE=64
SET TEXT="Ward Included in the Search List."
+12 if NODE=65
SET TEXT="Insurances Included in the Appointment Search List."
+13 if NODE=66
SET TEXT="Insurances Included in the Admissions Search List."
+14 WRITE @IOF,"Someone else is editing the "_TEXT
+15 WRITE !,"Please Try again later"
+16 DO PAUSE^VALM1
End DoDot:1
QUIT 0
+17 QUIT 1
+18 ;
UNLOCK(NODE) ;EP
+1 ; Unlocks the Site Parameter node that is being worked
+2 ; Input: NODE - Site Parameter node where the data resides
+3 LOCK -^IBE(350.9,1,NODE)
+4 QUIT
+5 ;
