Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBJPC1

IBJPC1.m

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