[613] | 1 | IBJPI4 ;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 | ;
|
---|
| 7 | Q ; Must be called at a tag
|
---|
| 8 | ;
|
---|
| 9 | ADD ; Add entry
|
---|
| 10 | N IBCT,IBPOS,DIR,DIRUT,DTOUT,DUOUT,DIROUT,X,Y,IBNAME,IBIEN,IBI
|
---|
| 11 | ; Refresh screen
|
---|
| 12 | S VALMBCK="R"
|
---|
| 13 | ; Find highest pos in list (1-10)
|
---|
| 14 | S IBCT=+$O(^TMP($J,"IBJPI3-LIST",11),-1)
|
---|
| 15 | ; Quit if count = 10
|
---|
| 16 | I IBCT=10 D Q
|
---|
| 17 | . D EN^DDIOL("Cannot add entry as all ten positions are populated!")
|
---|
| 18 | . D EN^DDIOL("Please modify an entry or delete an entry, if necessary!")
|
---|
| 19 | . D PAUSE^VALM1
|
---|
| 20 | ; Select pos for new entry
|
---|
| 21 | S IBPOS=$S(IBCT=0:1,1:$$SEL(IBCT+1,"",IBCT+1)) Q:'(IBPOS>0)
|
---|
| 22 | ; Full screen
|
---|
| 23 | D FULL^VALM1
|
---|
| 24 | ; Select Payer
|
---|
| 25 | S IBIEN=$$PYRLKUP(IBPOS,1) Q:'(IBIEN>0)
|
---|
| 26 | ; Quit, if dup
|
---|
| 27 | I $D(^TMP($J,"IBJPI3-IENS",IBIEN)) D Q
|
---|
| 28 | . D EN^DDIOL("Payer already in list, please try again!")
|
---|
| 29 | . D PAUSE^VALM1
|
---|
| 30 | ; Add entry and shift others following down by one
|
---|
| 31 | F IBI=IBCT:-1:IBPOS S ^TMP($J,"IBJPI3-LIST",IBI+1)=^TMP($J,"IBJPI3-LIST",IBI)
|
---|
| 32 | S ^TMP($J,"IBJPI3-LIST",IBPOS)=IBIEN
|
---|
| 33 | S ^TMP($J,"IBJPI3-IENS",IBIEN)=""
|
---|
| 34 | S ^TMP($J,"IBJPI3-MODS")=""
|
---|
| 35 | ; Kill header to force refresh
|
---|
| 36 | K VALMHDR
|
---|
| 37 | ; Rebuild display
|
---|
| 38 | D DISP^IBJPI3
|
---|
| 39 | Q
|
---|
| 40 | ;
|
---|
| 41 | DELETE ; Delete entry
|
---|
| 42 | N IBCT,IBPOS,DIR,DIRUT,DTOUT,DUOUT,DIROUT,X,Y,IBNAME,IBIEN,IBI
|
---|
| 43 | ; Refresh screen
|
---|
| 44 | S VALMBCK="R"
|
---|
| 45 | ; Find highest pos in list (1-10)
|
---|
| 46 | S IBCT=+$O(^TMP($J,"IBJPI3-LIST",11),-1)
|
---|
| 47 | ; Quit, if list is empty
|
---|
| 48 | I IBCT=0 D Q
|
---|
| 49 | . D EN^DDIOL("Cannot delete entry as list is empty!")
|
---|
| 50 | . D PAUSE^VALM1
|
---|
| 51 | ; Select pos to delete
|
---|
| 52 | S IBPOS=$S(IBCT=1:1,1:$$SEL(IBCT)) Q:'(IBPOS>0)
|
---|
| 53 | ; Display Payer Name
|
---|
| 54 | W " ",$E($P($G(^IBE(365.12,+$G(^TMP($J,"IBJPI3-LIST",IBPOS)),0)),U,1),1,40)
|
---|
| 55 | ; Confirm deletion
|
---|
| 56 | S DIR(0)="Y"
|
---|
| 57 | S DIR("A")="Please confirm deletion of this entry"
|
---|
| 58 | S DIR("B")="NO"
|
---|
| 59 | D ^DIR
|
---|
| 60 | I $D(DIRUT)!'Y Q
|
---|
| 61 | ; Save IEN to delete
|
---|
| 62 | S IBIEN=$G(^TMP($J,"IBJPI3-LIST",IBPOS))
|
---|
| 63 | ; Shift entries in list following deleted entry up by one
|
---|
| 64 | F IBI=IBPOS:1:IBCT-1 S ^TMP($J,"IBJPI3-LIST",IBI)=^TMP($J,"IBJPI3-LIST",IBI+1)
|
---|
| 65 | K ^TMP($J,"IBJPI3-IENS",IBIEN)
|
---|
| 66 | K ^TMP($J,"IBJPI3-LIST",IBCT)
|
---|
| 67 | S ^TMP($J,"IBJPI3-MODS")=""
|
---|
| 68 | ; Kill header to force refresh
|
---|
| 69 | K VALMHDR
|
---|
| 70 | ; Build display
|
---|
| 71 | D DISP^IBJPI3
|
---|
| 72 | Q
|
---|
| 73 | ;
|
---|
| 74 | MODIFY ; Modify entry
|
---|
| 75 | N IBCT,IBPOS,DIR,DIRUT,DTOUT,DUOUT,DIROUT,X,Y,IBNAME,IBNIEN,IBOIEN,IBI
|
---|
| 76 | ; Refresh screen
|
---|
| 77 | S VALMBCK="R"
|
---|
| 78 | ; Find highest pos in list (1-10)
|
---|
| 79 | S IBCT=+$O(^TMP($J,"IBJPI3-LIST",11),-1)
|
---|
| 80 | ; Quit, if list is empty
|
---|
| 81 | I IBCT=0 D Q
|
---|
| 82 | . D EN^DDIOL("Cannot modify entry as list is empty!")
|
---|
| 83 | . D PAUSE^VALM1
|
---|
| 84 | ; Select pos to modify
|
---|
| 85 | S IBPOS=$S(IBCT=1:1,1:$$SEL(IBCT)) Q:'(IBPOS>0)
|
---|
| 86 | ; Display Payer Name
|
---|
| 87 | W " ",$E($P($G(^IBE(365.12,+$G(^TMP($J,"IBJPI3-LIST",IBPOS)),0)),U,1),1,40)
|
---|
| 88 | ; Full screen
|
---|
| 89 | D FULL^VALM1
|
---|
| 90 | ; Select payer
|
---|
| 91 | S IBNIEN=$$PYRLKUP(IBPOS,0) Q:'(IBNIEN>0)
|
---|
| 92 | ; Orig IEN
|
---|
| 93 | S IBOIEN=$G(^TMP($J,"IBJPI3-LIST",IBPOS))
|
---|
| 94 | I IBOIEN=IBNIEN D Q
|
---|
| 95 | . D EN^DDIOL("No change, please try again!")
|
---|
| 96 | . D PAUSE^VALM1
|
---|
| 97 | ; Quit, if dup
|
---|
| 98 | I $D(^TMP($J,"IBJPI3-IENS",IBNIEN)),$G(^TMP($J,"IBJPI3-LIST",IBPOS))'=IBNIEN D Q
|
---|
| 99 | . D EN^DDIOL("Payer already in list, please try again!")
|
---|
| 100 | . D PAUSE^VALM1
|
---|
| 101 | ; Update list and IEN index
|
---|
| 102 | S ^TMP($J,"IBJPI3-LIST",IBPOS)=IBNIEN
|
---|
| 103 | S ^TMP($J,"IBJPI3-IENS",IBNIEN)=""
|
---|
| 104 | ; Kill orig IEN entry
|
---|
| 105 | K ^TMP($J,"IBJPI3-IENS",IBOIEN)
|
---|
| 106 | S ^TMP($J,"IBJPI3-MODS")=""
|
---|
| 107 | ; Kill header to force refresh
|
---|
| 108 | K VALMHDR
|
---|
| 109 | ; Rebuild display
|
---|
| 110 | D DISP^IBJPI3
|
---|
| 111 | Q
|
---|
| 112 | ;
|
---|
| 113 | REORDER ; Reorder entry
|
---|
| 114 | N IBCT,IBPOS,DIR,DIRUT,DTOUT,DUOUT,DIROUT,X,Y,IBNAME,IBNPOS,IBOPOS,IBI
|
---|
| 115 | N IBOIEN
|
---|
| 116 | ; Refresh screen
|
---|
| 117 | S VALMBCK="R"
|
---|
| 118 | ; Find highest pos in list (1-10)
|
---|
| 119 | S IBCT=+$O(^TMP($J,"IBJPI3-LIST",11),-1)
|
---|
| 120 | ; Quit, if list is empty
|
---|
| 121 | I IBCT<2 D Q
|
---|
| 122 | . D EN^DDIOL("Cannot reorder entries as list is too small!")
|
---|
| 123 | . D PAUSE^VALM1
|
---|
| 124 | ; Select pos to reorder
|
---|
| 125 | S IBOPOS=$$SEL(IBCT) Q:'(IBOPOS>0)
|
---|
| 126 | ; Display Payer Name
|
---|
| 127 | W " ",$E($P($G(^IBE(365.12,+$G(^TMP($J,"IBJPI3-LIST",IBOPOS)),0)),U,1),1,40)
|
---|
| 128 | ; Select new pos
|
---|
| 129 | S IBNPOS=$$SEL(IBCT,1) Q:'(IBNPOS>0)
|
---|
| 130 | ; Quit, if no change
|
---|
| 131 | I IBOPOS=IBNPOS D Q
|
---|
| 132 | . D EN^DDIOL("New Position = Original Position, please try again!")
|
---|
| 133 | . D PAUSE^VALM1
|
---|
| 134 | ; Reorder to lower pos
|
---|
| 135 | I IBOPOS<IBNPOS D
|
---|
| 136 | . ; Orig IEN
|
---|
| 137 | . S IBOIEN=$G(^TMP($J,"IBJPI3-LIST",IBOPOS))
|
---|
| 138 | . ; Shift entries following orig entry up by one
|
---|
| 139 | . F IBI=IBOPOS:1:IBNPOS-1 S ^TMP($J,"IBJPI3-LIST",IBI)=^TMP($J,"IBJPI3-LIST",IBI+1)
|
---|
| 140 | . ; Set orig IEN in new pos
|
---|
| 141 | . S ^TMP($J,"IBJPI3-LIST",IBNPOS)=IBOIEN
|
---|
| 142 | ; Reorder to higher pos
|
---|
| 143 | I IBNPOS<IBOPOS D
|
---|
| 144 | . ; Save orig IEN
|
---|
| 145 | . S IBOIEN=$G(^TMP($J,"IBJPI3-LIST",IBOPOS))
|
---|
| 146 | . ; Shift entries before original entry down by one
|
---|
| 147 | . F IBI=IBOPOS:-1:IBNPOS+1 S ^TMP($J,"IBJPI3-LIST",IBI)=^TMP($J,"IBJPI3-LIST",IBI-1)
|
---|
| 148 | . ; Set orig IEN in new pos
|
---|
| 149 | . S ^TMP($J,"IBJPI3-LIST",IBNPOS)=IBOIEN
|
---|
| 150 | S ^TMP($J,"IBJPI3-MODS")=""
|
---|
| 151 | ; Kill header to force refresh
|
---|
| 152 | K VALMHDR
|
---|
| 153 | ; Rebuild display
|
---|
| 154 | D DISP^IBJPI3
|
---|
| 155 | Q
|
---|
| 156 | ;
|
---|
| 157 | RESTORE ; Restore list from site params
|
---|
| 158 | N DIR,DIRUT,DTOUT,DUOUT,DIROUT,X,Y
|
---|
| 159 | ; Refresh screen
|
---|
| 160 | S VALMBCK="R"
|
---|
| 161 | I '$D(^TMP($J,"IBJPI3-MODS")) D Q
|
---|
| 162 | . D EN^DDIOL("No actions have been performed, restore unnecessary.")
|
---|
| 163 | . D PAUSE^VALM1
|
---|
| 164 | ; Confirm restore
|
---|
| 165 | S DIR(0)="Y"
|
---|
| 166 | S DIR("A")="Please confirm restore of the last saved list"
|
---|
| 167 | S DIR("B")="NO"
|
---|
| 168 | D ^DIR
|
---|
| 169 | I $D(DIRUT)!'Y Q
|
---|
| 170 | ; Kill header to force refresh
|
---|
| 171 | K VALMHDR
|
---|
| 172 | ; Build list with site params
|
---|
| 173 | D BLD^IBJPI3
|
---|
| 174 | K ^TMP($J,"IBJPI3-MODS")
|
---|
| 175 | ; Rebuild display
|
---|
| 176 | D DISP^IBJPI3
|
---|
| 177 | Q
|
---|
| 178 | ;
|
---|
| 179 | SAVE ; Save list to Site Params file
|
---|
| 180 | N DIR,DIRUT,DTOUT,DUOUT,DIROUT,X,Y
|
---|
| 181 | ; Refresh screen
|
---|
| 182 | S VALMBCK="R"
|
---|
| 183 | ; Temp until file is updated
|
---|
| 184 | ;Q
|
---|
| 185 | I '$D(^TMP($J,"IBJPI3-MODS")) D Q
|
---|
| 186 | . D EN^DDIOL("No actions have been performed, save unnecessary.")
|
---|
| 187 | . D PAUSE^VALM1
|
---|
| 188 | ; Confirm save to site params
|
---|
| 189 | S DIR(0)="Y"
|
---|
| 190 | S DIR("A")="Please confirm save of the current list"
|
---|
| 191 | S DIR("B")="NO"
|
---|
| 192 | D ^DIR
|
---|
| 193 | I $D(DIRUT)!'Y Q
|
---|
| 194 | ; File changes
|
---|
| 195 | D FILE
|
---|
| 196 | ; Kill header to force refresh
|
---|
| 197 | K VALMHDR
|
---|
| 198 | ; Build list with site params
|
---|
| 199 | D BLD^IBJPI3
|
---|
| 200 | K ^TMP($J,"IBJPI3-MODS")
|
---|
| 201 | ; Rebuild display
|
---|
| 202 | D DISP^IBJPI3
|
---|
| 203 | Q
|
---|
| 204 | ;
|
---|
| 205 | FILE ; Delete orig list and file new one
|
---|
| 206 | ; Temp until file is updated
|
---|
| 207 | ;Q
|
---|
| 208 | N DIK,DA,IBCT,FDA
|
---|
| 209 | ; Kill existing list entries
|
---|
| 210 | S DIK="^IBE(350.9,1,51.18,",DA(1)=1
|
---|
| 211 | F DA=1:1:10 I $D(^IBE(350.9,1,51.18,DA)) D ^DIK
|
---|
| 212 | ; Loop thru list entries and update 350.9 mult fld for most pop
|
---|
| 213 | F IBCT=1:1:10 I $D(^TMP($J,"IBJPI3-LIST",IBCT)) S FDA(350.9003,"+1,1,",.01)=$P($G(^TMP($J,"IBJPI3-LIST",IBCT)),U,1) D UPDATE^DIE("","FDA")
|
---|
| 214 | ; Init FDA array
|
---|
| 215 | K FDA
|
---|
| 216 | ; Update List start and end dts and compile dt
|
---|
| 217 | S FDA(350.9,"1,",51.11)=""
|
---|
| 218 | S FDA(350.9,"1,",51.12)=""
|
---|
| 219 | S FDA(350.9,"1,",51.21)=$$NOW^XLFDT
|
---|
| 220 | ; Save data to File (350.9)
|
---|
| 221 | D FILE^DIE("","FDA")
|
---|
| 222 | ;
|
---|
| 223 | Q
|
---|
| 224 | ;
|
---|
| 225 | SEL(MAX,NWFLG,DFLT) ; Select Position
|
---|
| 226 | ; Input: MAX - upper bound > 0, NWFLG - opt param for 'New' prompt
|
---|
| 227 | ; Output: -1 (time out or '^') OR n (1<=n<=MAX) OR 0
|
---|
| 228 | N DIR,DIRUT,DTOUT,DUOUT,IBX,X,Y
|
---|
| 229 | ; Init output
|
---|
| 230 | S IBX=0
|
---|
| 231 | ; Validate MAX
|
---|
| 232 | I '(MAX>0) Q IBX
|
---|
| 233 | ; Init flag
|
---|
| 234 | S NWFLG=$G(NWFLG,0)
|
---|
| 235 | S DFLT=$G(DFLT)
|
---|
| 236 | ; Select (New) Position
|
---|
| 237 | S DIR(0)="NOA^1:"_MAX_":0^K:X'>0!(X>"_MAX_") X"
|
---|
| 238 | S DIR("A")="Select "_$S(NWFLG:"New ",1:"")_"Position (1-"_MAX_"): "
|
---|
| 239 | I DFLT>0 S DIR("B")=DFLT
|
---|
| 240 | S DIR("?")="Please enter a valid position between 1 and "_MAX
|
---|
| 241 | D ^DIR
|
---|
| 242 | S IBX=$S($D(DIRUT):-1,+Y:+Y,1:0)
|
---|
| 243 | Q IBX
|
---|
| 244 | ;
|
---|
| 245 | PYRLKUP(IBPOS,ADDFLG) ; Lookup Payer IEN
|
---|
| 246 | N DIC,DTOUT,DUOUT,X,Y,PYRIEN
|
---|
| 247 | ;
|
---|
| 248 | S DIC=365.12
|
---|
| 249 | S DIC(0)="ABEV"
|
---|
| 250 | S DIC("A")="Enter Payer #"_IBPOS_": "
|
---|
| 251 | S DIC("?")=" Please enter a partial payer name to select a payer."
|
---|
| 252 | S DIC("S")="I $$PYRFLTR^IBCNEUT6"
|
---|
| 253 | S DIC("W")="W $$DSPLINE^IBCNEUT6"
|
---|
| 254 | S PYRIEN=$G(^TMP($J,"IBJPI3-LIST",IBPOS))
|
---|
| 255 | ;
|
---|
| 256 | ; Set default if not adding
|
---|
| 257 | I PYRIEN,'$G(ADDFLG) S DIC("B")=PYRIEN
|
---|
| 258 | D ^DIC
|
---|
| 259 | Q +Y
|
---|
| 260 | ;
|
---|
| 261 | EXIT ; Exit action
|
---|
| 262 | S VALMBCK="R"
|
---|
| 263 | ; If the list has been acted upon, prompt for save
|
---|
| 264 | I $D(^TMP($J,"IBJPI3-MODS")) D
|
---|
| 265 | . D EN^DDIOL("Unsaved changes exist!")
|
---|
| 266 | . D SAVE
|
---|
| 267 | ; Call Fast Exit at this point
|
---|
| 268 | D FASTEXIT^IBJU1
|
---|
| 269 | Q
|
---|
| 270 | ;
|
---|
| 271 | ;
|
---|