- 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 Jan 18, 2025@03:24:41 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 ;