source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJPI3.m@ 1464

Last change on this file since 1464 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1IBJPI3 ;DAOU/BHS - IBJP IIV MOST POPULAR PAYER LIST SCREEN ;25-NOV-2003
2 ;;2.0;INTEGRATED BILLING;**271**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; IIV - Insurance Identification and Verification Interface
6 ;
7EN ; -- main entry pt for IBJP IIV MOST POPULAR PAYERS
8 N POP,X,CTRLCOL,VALMHDR,VALMCNT,%DT
9 D EN^VALM("IBJP IIV MOST POPULAR PAYERS")
10 Q
11 ;
12HDR ; -- header code
13 S VALMHDR(1)=" "_$S($D(^TMP($J,"IBJPI3-MODS")):"Unsaved Changes Exist",1:"Last Saved: "_$$FMTE^XLFDT($P($G(^IBE(350.9,1,51)),U,21),"5Z"))
14 S VALMHDR(2)=" "_$$FO^IBCNEUT1(" ",49)_" "_$$FO^IBCNEUT1(" ",11)_" Nat. Loc."
15 S VALMHDR(3)=" # "_$$FO^IBCNEUT1("Payer Name ",49)_" "_$$FO^IBCNEUT1("National ID",11)_" Act? Act?"
16 Q
17 ;
18INIT ; -- init vars and list array
19 ; Init temp globals
20 K ^TMP($J,"IBJPI3")
21 K ^TMP($J,"IBJPI3-IENS")
22 K ^TMP($J,"IBJPI3-LIST")
23 K ^TMP($J,"IBJPI3-MODS")
24 D CLEAN^VALM10 ; Kills data and video control arrays w/active list
25 D BLD ; Build list from site params
26 D DISP ; Build display array
27 Q
28 ;
29HELP ; HELP screen for Most Pop screen
30 D FULL^VALM1 ; Full screen mode
31 W @IOF
32 D EN^DDIOL("Most Popular Payer List Edit Actions")
33 D EN^DDIOL(" ")
34 D EN^DDIOL("Add Entry - Inserts a new payer into the list at any position as")
35 D EN^DDIOL(" long as the list has fewer than ten entries. The entry will be inserted and")
36 D EN^DDIOL(" existing entries from the new position through the end of the list will be")
37 D EN^DDIOL(" shifted down one position.")
38 D EN^DDIOL(" ")
39 D EN^DDIOL("Delete Entry - Deletes a payer from the list at any position as")
40 D EN^DDIOL(" long as the list has at least one entry. The entries following the deleted")
41 D EN^DDIOL(" entry will be shifted up one position.")
42 D EN^DDIOL(" ")
43 D EN^DDIOL("Modify Entry - Modifies a payer from the list at any position as")
44 D EN^DDIOL(" long as the list has at least one entry. The new payer must be")
45 D EN^DDIOL(" valid in order to replace the existing entry.")
46 D EN^DDIOL(" ")
47 D EN^DDIOL("Print Current List - Allows the user to specify a device and print the current")
48 D EN^DDIOL(" items in the list.")
49 D PAUSE^VALM1
50 D EN^DDIOL("Reorder Entry - Changes a payer from the list at any position to")
51 D EN^DDIOL(" another position so long as the list has at least two entries. Moving the")
52 D EN^DDIOL(" entry to a lower position shifts entries following the original position up")
53 D EN^DDIOL(" one position except for those lower than the new position. Moving the entry")
54 D EN^DDIOL(" to a higher position shifts entries following the new position down one")
55 D EN^DDIOL(" position except for those lower than the original position.")
56 D EN^DDIOL(" ")
57 D EN^DDIOL("Restore Saved List - If editing actions were performed, the user will be")
58 D EN^DDIOL(" prompted to verify that they wish to discard all changes.")
59 D EN^DDIOL(" ")
60 D EN^DDIOL("Save Current List - Saves the current list to the Site Parameters file.")
61 D EN^DDIOL(" ")
62 D EN^DDIOL("Exit Action - If editing actions were performed, the user will be prompted")
63 D EN^DDIOL(" to save the current list or exit without filing changes.")
64 D PAUSE^VALM1 ; Press return to continue
65 W @IOF
66 S VALMBCK="R" ; Refresh screen
67 Q
68 ;
69EXIT ; -- exit code
70 S VALMBCK="R"
71 ; If the list has been acted upon, prompt for save
72 I $D(^TMP($J,"IBJPI3-MODS")) D
73 . D EN^DDIOL("Unsaved changes exist!")
74 . D SAVE^IBJPI4
75 ; Kill temp globals
76 K ^TMP($J,"IBJPI3")
77 K ^TMP($J,"IBJPI3-LIST")
78 K ^TMP($J,"IBJPI3-IENS")
79 K ^TMP($J,"IBJPI3-MODS")
80 D CLEAN^VALM10 ; Kills data and video control arrays w/active list
81 Q
82 ;
83BLD ; -- build list array
84 N IBIEN,IBCT,IEN
85 ; Init temp globals
86 K ^TMP($J,"IBJPI3-LIST")
87 K ^TMP($J,"IBJPI3-IENS")
88 K ^TMP($J,"IBJPI3-MODS")
89 ; Loop thru current List of Payers
90 S (IEN,IBCT)=0
91 F S IEN=$O(^IBE(350.9,1,51.18,IEN)) Q:'IEN D
92 . S IBIEN=$P($G(^IBE(350.9,1,51.18,IEN,0)),U) Q:'IBIEN ; Bad IEN
93 . S IBCT=IBCT+1
94 . S ^TMP($J,"IBJPI3-LIST",IBCT)=IBIEN ; List by pos
95 . S ^TMP($J,"IBJPI3-IENS",IBIEN)="" ; IEN index
96 Q
97 ;
98DISP ; Build display array of text
99 N IBI,IBIEN,IBST,IBLN,IBAIEN,IBADATA
100 ; Init display global
101 K ^TMP($J,"IBJPI3")
102 ; Loop thru current list of Payers
103 S IBLN=0
104 F IBI=1:1:10 S IBIEN=$G(^TMP($J,"IBJPI3-LIST",IBI)) Q:'IBIEN D
105 . S IBST=$$FO^IBCNEUT1(IBI,3,"R")_". "
106 . ; Name
107 . S IBST=IBST_$$FO^IBCNEUT1($P($G(^IBE(365.12,IBIEN,0)),U),49)
108 . ; National ID
109 . S IBST=IBST_" "_$$FO^IBCNEUT1($P($G(^IBE(365.12,IBIEN,0)),U,2),11)
110 . S (IBAIEN,IBADATA)=""
111 . ; Payer App IEN
112 . S IBAIEN=$$PYRAPP^IBCNEUT5("IIV",IBIEN)
113 . ; WARNING - IIV application does not exist
114 . I IBAIEN="" D Q
115 . . S IBLN=$$SET(IBLN,IBST)
116 . . S IBST=" ** Please remove from this list: Payer not configured for IIV **"
117 . . S IBLN=$$SET(IBLN,IBST)
118 . S IBADATA=$G(^IBE(365.12,+IBIEN,1,+IBAIEN,0))
119 . ; Nat Act Flg
120 . S IBST=IBST_" "_$$FO^IBCNEUT1($S('$P(IBADATA,U,2):"NO",1:"YES"),4)
121 . ; Loc Act Flg
122 . S IBST=IBST_" "_$$FO^IBCNEUT1($S('$P(IBADATA,U,3):"NO",1:"YES"),4)
123 . S IBLN=$$SET(IBLN,IBST)
124 . ; WARNING - IIV application deactivated
125 . I +$P(IBADATA,U,11) D Q
126 . . S IBST=" ** Please remove from this list: Payer is deactivated for IIV **"
127 . . S IBLN=$$SET(IBLN,IBST)
128 . ; WARNING - Id Inq Req ID = YES & Use SSN as ID = NO
129 . I +$P(IBADATA,U,8),'$P(IBADATA,U,9) D
130 . . S IBST=" ** Please remove from this list: Inquiries w/o subscriber ID rejected **"
131 . . S IBLN=$$SET(IBLN,IBST)
132 ; No Data Found if $O(^TMP($J,"IBJPI3-LIST",0))=""
133 I $O(^TMP($J,"IBJPI3-LIST",0))="" S IBLN=$$SET(IBLN," *** NO DATA FOUND!!! ***")
134 ; Update line ct
135 S VALMCNT=IBLN
136 Q
137 ;
138SET(LN,STR) ; Build list array
139 S LN=$G(LN)+1
140 D SET^VALM10(LN,STR)
141 Q LN
142 ;
Note: See TracBrowser for help on using the repository browser.